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 2399 for branches/nemo_v3_3_beta – NEMO

Ignore:
Timestamp:
2010-11-17T10:09:35+01:00 (13 years ago)
Author:
gm
Message:

v3.3beta: diaptr (poleward heat & salt transports) #759 : rewriting including dynamical allocation + DOCTOR names

Location:
branches/nemo_v3_3_beta/NEMOGCM
Files:
22 edited

Legend:

Unmodified
Added
Removed

  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/GYRE/EXP00/namelist

    r2396 r2399  
    719719   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not  
    720720                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    721    nf_ptr     =  1         !  Frequency of ptr computation [time step] 
    722    nf_ptr_wri =  15        !  Frequency of ptr outputs 
     721   nn_fptr    =  1         !  Frequency of ptr computation [time step] 
     722   nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
    723723/ 
    724724!----------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist

    r2396 r2399  
    719719   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not  
    720720                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    721    nf_ptr     =  1         !  Frequency of ptr computation [time step] 
    722    nf_ptr_wri =  15        !  Frequency of ptr outputs 
     721   ln_ptrcomp = .false.    !  Add decomposition : overturning 
     722   nn_fptr    =  1         !  Frequency of ptr computation [time step] 
     723   nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
    723724/ 
    724725!----------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist

    r2396 r2399  
    727727   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not  
    728728                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    729    nf_ptr     =  1         !  Frequency of ptr computation [time step] 
    730    nf_ptr_wri =  15        !  Frequency of ptr outputs 
     729   ln_ptrcomp = .false.    !  Add decomposition : overturning 
     730   nn_fptr    =  1         !  Frequency of ptr computation [time step] 
     731   nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
    731732/ 
    732733!----------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r2396 r2399  
    765765                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    766766   ln_ptrcomp = .true.     !  Add decomposition : overturning 
    767    nf_ptr     =  1         !  Frequency of ptr computation [time step] 
    768    nf_ptr_wri =  15        !  Frequency of ptr outputs 
     767   nn_fptr    =  1         !  Frequency of ptr computation [time step] 
     768   nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
    769769/ 
    770770!----------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm

    r2370 r2399  
    1  bld::tool::fppkeys  key_trabbl key_vectopt_loop key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_iomput key_nproci=1 key_nprocj=1 
     1 bld::tool::fppkeys  key_trabbl key_vectopt_loop  key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_iomput key_nproci=1 key_nprocj=1  

  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist

    r2396 r2399  
    765765                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    766766   ln_ptrcomp = .true.     !  Add decomposition : overturning 
    767    nf_ptr     =  1         !  Frequency of ptr computation [time step] 
    768    nf_ptr_wri =  15        !  Frequency of ptr outputs 
     767   nn_fptr    =  1         !  Frequency of ptr computation [time step] 
     768   nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
    769769/ 
    770770!----------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist

    r2375 r2399  
    749749&namptr       !   Poleward Transport Diagnostic 
    750750!----------------------------------------------------------------------- 
    751    ln_diaptr  = .false.     !  Poleward heat and salt transport (T) or not (F) 
    752    ln_diaznl  = .true.     !  Add zonal means and meridional stream functions 
    753    ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not  
     751   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
     752   ln_diaznl  = .false.    !  Add zonal means and meridional stream functions 
     753   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not  
    754754                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    755    ln_ptrcomp = .true.     !  Add decomposition : overturning 
    756    nf_ptr     =  1         !  Frequency of ptr computation [time step] 
    757    nf_ptr_wri =  15        !  Frequency of ptr outputs 
     755   ln_ptrcomp = .false.    !  Add decomposition : overturning 
     756   nn_fptr    =  1         !  Frequency of ptr computation [time step] 
     757   nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
    758758/ 
    759759!----------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/POMME/EXP00/namelist

    r2371 r2399  
    760760   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not  
    761761                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    762    nf_ptr     =  1         !  Frequency of ptr computation [time step] 
    763    nf_ptr_wri =  15        !  Frequency of ptr outputs 
     762   ln_ptrcomp = .false.    !  Add decomposition : overturning 
     763   nn_fptr    =  1         !  Frequency of ptr computation [time step] 
     764   nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
    764765/ 
    765766!----------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90

    r2287 r2399  
    22   !!====================================================================== 
    33   !!                       ***  MODULE asmtrj  *** 
    4    !! Assimilation trajectory interface: Write to file the background state 
    5    !!                                    and the model state trajectory 
     4   !! Assimilation trajectory interface: Write to file the background state and the model state trajectory 
    65   !!====================================================================== 
     6   !! History :       ! 2007-03 (M. Martin)  Met. Office version 
     7   !!                 ! 2007-04 (A. Weaver)  asm_trj_wri, original code 
     8   !!                 ! 2007-03 (K. Mogensen)  Adapt to NEMOVAR and use IOM instead of IOIPSL 
     9   !!                 ! 2007-04 (A. Weaver)  Name change (formally asmbkg.F90). Distinguish 
     10   !!                                        background states in Jb term and at analysis time. 
     11   !!                                        Include state trajectory routine (currently empty) 
     12   !!                 ! 2007-07 (A. Weaver)  Add tke_rst and flt_rst for case nitbkg=0  
     13   !!                 ! 2009-03 (F. Vigilant)  Add hmlp (zdfmxl) for no tracer nmldp=2  
     14   !!                 ! 2009-06 (F. Vigilant) asm_trj_wri: special case when kt=nit000-1 
     15   !!                 ! 2009-07 (F. Vigilant) asm_trj_wri: add computation of eiv at restart 
     16   !!---------------------------------------------------------------------- 
    717 
    818   !!---------------------------------------------------------------------- 
    … …  
    1222   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var) 
    1323   !!---------------------------------------------------------------------- 
    14    !! * Modules used    
    1524   USE oce                ! Dynamics and active tracers defined in memory 
    1625   USE sbc_oce            ! Ocean surface boundary conditions 
    … …  
    2029   USE ldfslp             ! Slopes of neutral surfaces 
    2130   USE tradmp             ! Tracer damping 
    22  
    2331#if defined key_zdftke 
    2432   USE zdftke             ! TKE vertical physics 
    … …  
    2634   USE eosbn2             ! Equation of state (eos_bn2 routine) 
    2735   USE zdfmxl             ! Mixed layer depth 
    28    USE sol_oce, ONLY : &  ! Solver variables defined in memory 
    29       & gcx 
    30    USE in_out_manager, ONLY : &  ! I/O manager 
    31       & lwp,     & 
    32       & numout 
    33    USE dom_oce, ONLY : & 
    34       & ndastp 
    35    USE iom                 ! I/O module 
    36    USE asmpar              ! Parameters for the assmilation interface 
    37    USE zdfmxl, ONLY : &   ! mixed layer depth 
    38       & hmlp 
     36   USE dom_oce, ONLY :   ndastp 
     37   USE sol_oce, ONLY :   gcx   ! Solver variables defined in memory 
     38   USE in_out_manager     ! I/O manager 
     39   USE iom                ! I/O module 
     40   USE asmpar             ! Parameters for the assmilation interface 
     41   USE zdfmxl             ! mixed layer depth 
    3942#if defined key_traldf_c2d 
    40    USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine) 
     43   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine) 
    4144#endif 
    4245 
    4346   IMPLICIT NONE 
    44  
    45    !! * Routine accessibility 
    4647   PRIVATE 
    47    PUBLIC asm_bkg_wri, &  !: Write out the background state 
    48       &   asm_trj_wri     !: Write out the background state 
     48    
     49   PUBLIC   asm_bkg_wri   !: Write out the background state 
     50   PUBLIC   asm_trj_wri   !: Write out the background state 
    4951 
    5052   !!---------------------------------------------------------------------- 
    5153   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5254   !! $Id$ 
    53    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    54    !!---------------------------------------------------------------------- 
    55  
     55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     56   !!---------------------------------------------------------------------- 
    5657CONTAINS 
    5758 
    5859   SUBROUTINE asm_bkg_wri( kt ) 
    5960      !!----------------------------------------------------------------------- 
    60       !! 
    6161      !!                  ***  ROUTINE asm_bkg_wri *** 
    6262      !! 
    … …  
    6868      !!              in the cost function and for use with direct initialization 
    6969      !!              at analysis time. 
    70       !! 
    71       !! ** Action  : 
    72       !!                    
    73       !! References :  
    74       !! 
    75       !! History : 
    76       !!        ! 07-03 (M. Martin) Met. Office version 
    77       !!        ! 07-03 (K. Mogensen) Adapt to NEMOVAR and use IOM instead of IOIPSL 
    78       !!        ! 07-04 (A. Weaver) Name change (formally asmbkg.F90). Distinguish 
    79       !!                            background states in Jb term and at analysis time. 
    80       !!                            Include state trajectory routine (currently empty) 
    81       !!        ! 07-07 (A. Weaver) Add tke_rst and flt_rst for case nitbkg=0  
    82       !!----------------------------------------------------------------------- 
    83  
    84       !! * Arguments 
     70      !!----------------------------------------------------------------------- 
    8571      INTEGER, INTENT( IN ) :: kt               ! Current time-step 
    86  
    87       !! * Local declarations 
     72      ! 
    8873      CHARACTER (LEN=50) :: cl_asmbkg 
    8974      CHARACTER (LEN=50) :: cl_asmdin 
    … …  
    9176      INTEGER :: inum          ! File unit number 
    9277      REAL(wp) :: zdate        ! Date 
    93  
    94       !-------------------------------------------------------------------- 
    95       ! Write out background at time step nitbkg_r or nitdin_r 
    96       !-------------------------------------------------------------------- 
    97  
    98       IF ( kt == nitbkg_r ) THEN 
    99  
     78      !!----------------------------------------------------------------------- 
     79 
     80      !                                !------------------------------------------- 
     81      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r 
     82         !                             !-----------------------------------======== 
     83         ! 
    10084         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg ) 
    10185         cl_asmbkg = TRIM( cl_asmbkg ) 
    102  
    10386         INQUIRE( FILE = cl_asmbkg, EXIST = llok ) 
    104  
     87         ! 
    10588         IF( .NOT. llok ) THEN 
    106             IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// & 
    107                &                    TRIM( c_asmbkg ) 
    108  
    109             ! Define the output file         
     89            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg ) 
     90            ! 
     91            !                                      ! Define the output file         
    11092            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib) 
    111  
    112             ! Treat special case when nitbkg = 0 
    113             IF ( nitbkg_r == nit000 - 1 ) THEN 
    114                zdate = REAL( ndastp ) 
    115 #if defined key_zdftke 
     93            ! 
     94            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0 
     95               zdate = REAL( ndastp ) 
     96#if defined key_zdftke 
     97               ! lk_zdftke=T :   Read turbulent kinetic energy ( en ) 
    11698               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 
    117                ! Read turbulent kinetic energy ( en ) 
    118                CALL tke_rst( nit000, 'READ' ) 
     99               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :  Read turbulent kinetic energy ( en ) 
     100 
    119101#endif 
    120102            ELSE 
    121103               zdate = REAL( ndastp ) 
    122104            ENDIF 
    123  
    124             ! Write the information 
     105            ! 
     106            !                                      ! Write the information 
    125107            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   ) 
    126108            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un      ) 
    … …  
    133115#endif 
    134116            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx     ) 
    135  
     117            ! 
    136118            CALL iom_close( inum ) 
    137  
    138119         ENDIF 
    139  
     120         ! 
    140121      ENDIF 
    141122 
    142       IF ( kt == nitdin_r ) THEN 
    143  
     123      !                                !------------------------------------------- 
     124      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r 
     125         !                             !-----------------------------------======== 
     126         ! 
    144127         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin ) 
    145128         cl_asmdin = TRIM( cl_asmdin ) 
    146  
    147129         INQUIRE( FILE = cl_asmdin, EXIST = llok ) 
    148  
     130         ! 
    149131         IF( .NOT. llok ) THEN 
    150             IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// & 
    151                &                    TRIM( c_asmdin ) 
    152  
    153             ! Define the output file         
     132            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin ) 
     133            ! 
     134            !                                      ! Define the output file         
    154135            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib) 
    155  
    156             ! Treat special case when nitbkg = 0 
    157             IF ( nitdin_r == nit000 - 1) THEN 
     136            ! 
     137            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0 
     138 
    158139               zdate = REAL( ndastp ) 
    159140            ELSE 
    160141               zdate = REAL( ndastp ) 
    161142            ENDIF 
    162  
    163             ! Write the information 
     143            ! 
     144            !                                      ! Write the information 
    164145            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate   ) 
    165146            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un      ) 
    … …  
    168149            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , sn      ) 
    169150            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn    ) 
    170  
     151            ! 
    171152            CALL iom_close( inum ) 
    172  
    173153         ENDIF 
    174  
     154         ! 
    175155      ENDIF 
    176                                    
     156      !                     
    177157   END SUBROUTINE asm_bkg_wri 
    178158 
     159 
    179160   SUBROUTINE asm_trj_wri( kt ) 
    180161      !!----------------------------------------------------------------------- 
    181       !! 
    182162      !!                  ***  ROUTINE asm_trj_wri *** 
    183163      !! 
    184       !! ** Purpose : Write to file the model state trajectory for use with 
    185       !!              4D-Var. 
    186       !! 
    187       !! ** Method  :  
    188       !! 
    189       !! ** Action  : 
    190       !!                    
    191       !! References :  
    192       !! 
    193       !! History : 
    194       !!        ! 07-04 (A. Weaver)  
    195       !!        ! 09-03 (F. Vigilant) Add hmlp (zdfmxl) for no tracer nmldp=2  
    196       !!        ! 09-06 (F. Vigilant) special case when kt=nit000-1 
    197       !!        ! 09-07 (F. Vigilant) add computation of eiv at restart 
    198       !!----------------------------------------------------------------------- 
    199  
    200       !! * Arguments 
     164      !! ** Purpose :   Write to file the model state trajectory for use with 4D-Var. 
     165      !!----------------------------------------------------------------------- 
    201166      INTEGER, INTENT( IN ) :: kt             ! Current time-step 
    202  
    203       !! * Local declarations 
     167      ! 
    204168      INTEGER :: inum                  ! File unit number 
    205169      INTEGER :: it 
    206170      CHARACTER (LEN=50) :: cl_asmtrj 
    207171      REAL(wp) :: zdate            ! Date 
     172      !!----------------------------------------------------------------------- 
    208173 
    209174      !------------------------------------------------------------------------ 
    210175      ! Write a single file for each trajectory time step 
    211176      !------------------------------------------------------------------------ 
    212       IF ( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. & 
    213          & ( kt == nitend ) ) THEN 
     177      IF( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. ( kt == nitend ) ) THEN 
    214178          
    215          ! Treat special case when kt = nit000-1 
    216          IF ( kt == nit000 - 1 ) THEN 
     179         IF( kt == nit000 - 1 ) THEN         ! Treat special case when kt = nit000-1 
     180            ! 
    217181#if defined key_zdftke 
    218182            IF(lwp) WRITE(numout,*) ' Computing  zdf_tke coeff. form restart...' 
    … …  
    238202            IF( lk_traldf_eiv )   CALL ldf_eiv( nit000 ) 
    239203#endif 
    240           ENDIF 
    241  
    242  
     204         ENDIF 
     205         ! 
    243206         it = kt - nit000 + 1 
    244  
    245          ! Define the output file         
     207         ! 
     208         !                                   ! Define the output file         
    246209         WRITE(cl_asmtrj, FMT='(A,A,I5.5)' ) TRIM( c_asmtrj ), '_', it 
    247210         cl_asmtrj = TRIM( cl_asmtrj ) 
    248211         CALL iom_open( cl_asmtrj, inum, ldwrt = .TRUE., kiolib = jprstlib) 
    249  
    250          ! Output trajectory fields 
     212         ! 
     213         !                                   ! Output trajectory fields 
    251214         CALL iom_rstput( it, it, inum, 'emp'   , emp    ) 
    252215         CALL iom_rstput( it, it, inum, 'emps'  , emps   ) 
    … …  
    278241         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv   ) 
    279242         CALL iom_rstput( it, it, inum, 'aeiw'  , aeiw   ) 
    280  
     243         ! 
    281244         CALL iom_close( inum ) 
    282           
    283245      ENDIF 
    284  
     246      ! 
    285247   END SUBROUTINE asm_trj_wri 
    286248 
     249   !!====================================================================== 
    287250END MODULE asmtrj 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r2364 r2399  
    66   !! History :  1.0  ! 2003-09  (C. Talandier, G. Madec)  Original code 
    77   !!            2.0  ! 2006-01  (A. Biastoch)  Allow sub-basins computation 
    8    !!            3.2  ! 2003-03  (O. Marti, S. Flavoni) Add fields 
     8   !!            3.2  ! 2010-03  (O. Marti, S. Flavoni) Add fields 
     9   !!            3.3  ! 2010-10  (G. Madec)  dynamical allocation 
    910   !!---------------------------------------------------------------------- 
    1011 
    … …  
    1516   !!   ptr_vjk      : "zonal" sum computation of a "meridional" flux array 
    1617   !!   ptr_tjk      : "zonal" mean computation of a tracer field 
    17    !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional" 
    18    !!                : flux array; Generic interface: ptr_vj_3d, ptr_vj_2d 
     18   !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional" flux array 
     19   !!                   (Generic interface to ptr_vj_3d, ptr_vj_2d) 
    1920   !!---------------------------------------------------------------------- 
    20    USE oce           ! ocean dynamics and active tracers 
    21    USE dom_oce       ! ocean space and time domain 
    22    USE phycst        ! physical constants 
    23    USE ldftra_oce    ! ocean active tracers: lateral physics 
    24    USE dianam 
    25    USE iom 
    26    USE ioipsl          
    27    USE in_out_manager 
    28    USE lib_mpp 
    29    USE lbclnk 
     21   USE oce              ! ocean dynamics and active tracers 
     22   USE dom_oce          ! ocean space and time domain 
     23   USE phycst           ! physical constants 
     24   USE ldftra_oce       ! ocean active tracers: lateral physics 
     25   USE dianam           ! 
     26   USE iom              ! IOM library 
     27   USE ioipsl           ! IO-IPSL library 
     28   USE in_out_manager   ! I/O manager 
     29   USE lib_mpp          ! MPP library 
     30   USE lbclnk           ! lateral boundary condition - processor exchanges 
    3031 
    3132   IMPLICIT NONE 
    … …  
    4647   LOGICAL , PUBLIC ::   ln_diaznl  = .FALSE.   !: Add zonal means and meridional stream functions 
    4748   LOGICAL , PUBLIC ::   ln_ptrcomp = .FALSE.   !: Add decomposition : overturning (and gyre, soon ...) 
    48    INTEGER , PUBLIC ::   nf_ptr     = 15        !: frequency of ptr computation 
    49    INTEGER , PUBLIC ::   nf_ptr_wri = 15        !: frequency of ptr outputs 
    50  
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   abasin, pbasin, ibasin, dbasin, sbasin   !: Sub basin masks 
    52  
    53    !                                                               !!! poleward heat and salt transport 
    54    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_adv    , pst_adv       !: advection 
    55    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ldf    , pst_ldf       !: lateral diffusion 
    56    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_glo, pst_ove_glo   !: global       overturning 
    57    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_atl, pst_ove_atl   !: Atlantic     overturning 
    58    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_pac, pst_ove_pac   !: Pacific      overturning 
    59    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_ind, pst_ove_ind   !: Indian       overturning 
    60    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_ipc, pst_ove_ipc   !: Indo-Pacific overturning 
    61    REAL(wp), PUBLIC, DIMENSION(jpj) ::   ht_glo, ht_atl, ht_ind, ht_pac, ht_ipc   !: heat 
    62    REAL(wp), PUBLIC, DIMENSION(jpj) ::   st_glo, st_atl, st_ind, st_pac, st_ipc   !: salt 
    63  
    64    INTEGER ::   niter 
    65    INTEGER ::   nidom_ptr 
    66    INTEGER ::   numptr                                              !: logical unit for Poleward TRansports 
    67  
    68    REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_glo  , sn_jk_glo       ! global       i-mean temperature and salinity 
    69    REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_atl  , sn_jk_atl       ! Atlantic               -              - 
    70    REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_pac  , sn_jk_pac       ! Pacific                -              - 
    71    REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_ind  , sn_jk_ind       ! Indian                 -              - 
    72    REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_ipc  , sn_jk_ipc       ! Indo-Pacific           -              - 
    73    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_glo                    ! global       "meridional" Stream-Function 
    74    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_atl                    ! Atlantic               -              - 
    75    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_pac                    ! Pacific                -              - 
    76    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_ind                    ! Indian                 -              - 
    77    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_ipc                    ! Indo-Pacific           -              - 
    78    REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_glo, surf_jk_r_glo   ! surface of global       i-section and its inverse 
    79    REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_atl, surf_jk_r_atl   ! surface of Atlantic          -              - 
    80    REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_pac, surf_jk_r_pac   ! surface of Pacific           -              - 
    81    REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_ind, surf_jk_r_ind   ! surface of Indian            -              - 
    82    REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_ipc, surf_jk_r_ipc   ! surface of Indo-Pacific      -              - 
    83 #if defined key_diaeiv 
    84    !                                                               !!! eddy induced velocity (bolus) 
    85    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_glo, pst_eiv_glo   !: global       poleward heat and salt bolus advection 
    86    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_atl, pst_eiv_atl   !: Atlantic         -                           - 
    87    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_pac, pst_eiv_pac   !: Pacific          -                           - 
    88    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_ind, pst_eiv_ind   !: Indian           -                           - 
    89    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_ipc, pst_eiv_ipc   !: Indo-Pacific     -                           - 
    90  
    91    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_glo   ! global       "meridional" bolus Stream-Function 
    92    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_atl   ! Atlantic          -                   - 
    93    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_pac   ! Pacific           -                   - 
    94    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_ind   ! Indian            -                   - 
    95    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_ipc   ! Indo-Pacific      -                   - 
    96 #endif 
    97   
     49   INTEGER , PUBLIC ::   nn_fptr    = 15        !: frequency of ptr computation  [time step] 
     50   INTEGER , PUBLIC ::   nn_fwri    = 15        !: frequency of ptr outputs      [time step] 
     51 
     52   REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE ::   htr_adv, htr_ldf, htr_ove   !: Heat TRansports (adv, diff, overturn.) 
     53   REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE ::   str_adv, str_ldf, str_ove   !: Salt TRansports (adv, diff, overturn.) 
     54    
     55   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   btmsk                  ! T-point basin interior masks 
     56   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   btm30                  ! mask out Southern Ocean (=0 south of 30°S) 
     57   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   htr  , str             ! adv heat and salt transports (approx) 
     58   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   tn_jk, sn_jk , v_msf   ! i-mean T and S, j-Stream-Function 
     59   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   sjk  , r1_sjk          ! i-mean i-k-surface and its inverse         
     60#if defined key_diaeiv 
     61   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   htr_eiv, str_eiv   ! bolus adv heat ans salt transports    ('key_diaeiv') 
     62   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   v_msf_eiv          ! bolus j-streamfuction                 ('key_diaeiv') 
     63#endif 
     64 
     65   INTEGER ::   niter       ! 
     66   INTEGER ::   nidom_ptr   ! 
     67   INTEGER ::   numptr      ! logical unit for Poleward TRansports 
     68   INTEGER ::   nptr        ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T)  
     69 
     70   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
     71   REAL(wp) ::   rc_pwatt = 1.e-15_wp  ! conversion from W    to PW (further x rau0 x Cp) 
     72   REAL(wp) ::   rc_ggram = 1.e-6_wp   ! conversion from g    to Pg 
     73 
    9874   !! * Substitutions 
    9975#  include "domzgr_substitute.h90" 
    … …  
    10278   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    10379   !! $Id$  
    104    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     80   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    10581   !!---------------------------------------------------------------------- 
    106  
    10782CONTAINS 
    10883 
    … …  
    11186      !!                    ***  ROUTINE ptr_vj_3d  *** 
    11287      !! 
    113       !! ** Purpose :   "zonal" and vertical sum computation of a "meridional" 
    114       !!              flux array 
     88      !! ** Purpose :   i-k sum computation of a j-flux array 
    11589      !! 
    11690      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    … …  
    127101      ! 
    128102      ijpj = jpj 
    129       p_fval(:) = 0.e0 
     103      p_fval(:) = 0._wp 
    130104      DO jk = 1, jpkm1 
    131105         DO jj = 2, jpjm1 
    … …  
    137111      ! 
    138112#if defined key_mpp_mpi 
    139       CALL mpp_sum( p_fval, ijpj, ncomm_znl)     !!bug  I presume 
     113      CALL mpp_sum( p_fval, ijpj, ncomm_znl) 
    140114#endif 
    141115      ! 
    … …  
    147121      !!                    ***  ROUTINE ptr_vj_2d  *** 
    148122      !! 
    149       !! ** Purpose :   "zonal" and vertical sum computation of a "meridional" 
    150       !!      flux array 
     123      !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array 
    151124      !! 
    152125      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    … …  
    163136      !  
    164137      ijpj = jpj 
    165       p_fval(:) = 0.e0 
     138      p_fval(:) = 0._wp 
    166139      DO jj = 2, jpjm1 
    167140         DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    … …  
    171144      ! 
    172145#if defined key_mpp_mpi 
    173       CALL mpp_sum( p_fval, ijpj, ncomm_znl )     !!bug  I presume 
     146      CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 
    174147#endif 
    175148      !  
    … …  
    177150 
    178151 
    179    FUNCTION ptr_vjk( pva, bmask )   RESULT ( p_fval ) 
     152   FUNCTION ptr_vjk( pva, pmsk )   RESULT ( p_fval ) 
    180153      !!---------------------------------------------------------------------- 
    181154      !!                    ***  ROUTINE ptr_vjk  *** 
    182155      !! 
    183       !! ** Purpose :   "zonal" sum computation of a "meridional" flux array 
     156      !! ** Purpose :   i-sum computation of a j-velocity array 
    184157      !! 
    185158      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i). 
    186       !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
    187       !! 
    188       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    189       !!---------------------------------------------------------------------- 
    190       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva     ! mask flux array at V-point 
    191       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   bmask   ! Optional 2D basin mask 
     159      !!              pva is supposed to be a masked flux (i.e. * vmask) 
     160      !! 
     161      !! ** Action  : - p_fval: i-mean poleward flux of pva 
     162      !!---------------------------------------------------------------------- 
     163      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point 
     164      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask 
    192165      !! 
    193166      INTEGER                      ::   ji, jj, jk   ! dummy loop arguments 
    … …  
    200173      !!-------------------------------------------------------------------- 
    201174      ! 
    202       p_fval(:,:) = 0.e0 
    203       ! 
    204       IF( PRESENT( bmask ) ) THEN  
     175      p_fval(:,:) = 0._wp 
     176      ! 
     177      IF( PRESENT( pmsk ) ) THEN  
    205178         DO jk = 1, jpkm1 
    206179            DO jj = 2, jpjm1 
    207180!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei.... 
    208181               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    209                   p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk)   & 
    210                      &                                          * tmask_i(ji,jj) * bmask(ji,jj) 
     182                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj) 
    211183               END DO 
    212184            END DO 
    … …  
    216188            DO jj = 2, jpjm1 
    217189               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    218                   p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk)   & 
    219                      &                                          * tmask_i(ji,jj) 
     190                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj) 
    220191               END DO 
    221192            END DO 
    … …  
    233204 
    234205 
    235    FUNCTION ptr_tjk( pta, bmask )   RESULT ( p_fval ) 
     206   FUNCTION ptr_tjk( pta, pmsk )   RESULT ( p_fval ) 
    236207      !!---------------------------------------------------------------------- 
    237208      !!                    ***  ROUTINE ptr_tjk  *** 
    238209      !! 
    239       !! ** Purpose :   "zonal" mean computation of a tracer field 
     210      !! ** Purpose :   i-sum computation of e1t*e3t * a tracer field 
    240211      !! 
    241212      !! ** Method  : - i-sum of mj(pta) using tmask 
    242       !!      multiplied by the inverse of the surface of the "zonal" ocean 
    243       !!      section 
    244       !! 
    245       !! ** Action  : - p_fval: i-k-mean poleward flux of pta 
     213      !! 
     214      !! ** Action  : - p_fval: i-sum of e1t*e3t*pta 
    246215      !!---------------------------------------------------------------------- 
    247216      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point 
    248       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: bmask ! Optional 2D basin mask 
     217      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk  ! Optional 2D basin mask 
    249218      !! 
    250219      INTEGER                     ::   ji, jj, jk   ! dummy loop arguments 
    … …  
    257226      !!--------------------------------------------------------------------  
    258227      ! 
    259       p_fval(:,:) = 0.e0 
    260       IF (PRESENT (bmask)) THEN  
    261          DO jk = 1, jpkm1 
    262             DO jj = 2, jpjm1 
    263                DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    264                   p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk)                  & 
    265                      &                          * e1t(ji,jj) * fse3t(ji,jj,jk)   & 
    266                      &                          * tmask_i(ji,jj)                 & 
    267                      &                          * bmask(ji,jj) 
    268                END DO 
     228      p_fval(:,:) = 0._wp 
     229      DO jk = 1, jpkm1 
     230         DO jj = 2, jpjm1 
     231            DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
     232               p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj) 
    269233            END DO 
    270234         END DO 
    271       ELSE  
    272          DO jk = 1, jpkm1 
    273             DO jj = 2, jpjm1 
    274                DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    275                   p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk)                  & 
    276                      &                          * e1t(ji,jj) * fse3t(ji,jj,jk)   & 
    277                      &                          * tmask_i(ji,jj) 
    278                END DO 
    279             END DO 
    280          END DO 
    281       END IF 
    282       p_fval(:,:) = p_fval(:,:) * 0.5 
     235      END DO 
    283236#if defined key_mpp_mpi 
    284237      ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    285238      zwork(:)= RESHAPE( p_fval, ish ) 
    286239      CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 
    287       p_fval(:,:)= RESHAPE(zwork,ish2) 
     240      p_fval(:,:)= RESHAPE( zwork, ish2 ) 
    288241#endif 
    289242      ! 
    … …  
    295248      !!                  ***  ROUTINE dia_ptr  *** 
    296249      !!---------------------------------------------------------------------- 
     250      USE oce,     vt  =>   ua   ! use ua as workspace 
     251      USE oce,     vs  =>   ua   ! use ua as workspace 
     252      !! 
    297253      INTEGER, INTENT(in) ::   kt   ! ocean time step index 
    298       !! 
    299       INTEGER  ::   jk, jj, ji   ! dummy loop 
    300       REAL(wp) ::   zsverdrup    ! conversion from m3/s to Sverdrup 
    301       REAL(wp) ::   zpwatt       ! conversion from W    to PW 
    302       REAL(wp) ::   zggram       ! conversion from g    to Pg 
    303       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   vt, vs   ! 3D workspace 
    304       !!---------------------------------------------------------------------- 
    305  
    306       IF( kt == nit000 .OR. MOD( kt, nf_ptr ) == 0 )   THEN 
    307  
    308          IF ( MOD( kt, nf_ptr ) == 0 ) THEN  
    309  
    310             zsverdrup = 1.e-6 
    311             zpwatt    = 1.e-15 
    312             zggram    = 1.e-6 
    313  
    314             IF ( ln_diaznl ) THEN 
    315                ! "zonal" mean temperature and salinity at V-points 
    316                tn_jk_glo(:,:) = ptr_tjk( tn(:,:,:) ) * surf_jk_r_glo(:,:) 
    317                sn_jk_glo(:,:) = ptr_tjk( sn(:,:,:) ) * surf_jk_r_glo(:,:) 
    318  
    319                IF (ln_subbas) THEN  
    320                   tn_jk_atl(:,:) = ptr_tjk( tn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 
    321                   sn_jk_atl(:,:) = ptr_tjk( sn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 
    322                   tn_jk_pac(:,:) = ptr_tjk( tn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 
    323                   sn_jk_pac(:,:) = ptr_tjk( sn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 
    324                   tn_jk_ind(:,:) = ptr_tjk( tn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 
    325                   sn_jk_ind(:,:) = ptr_tjk( sn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 
    326                   tn_jk_ipc(:,:) = ptr_tjk( tn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 
    327                   sn_jk_ipc(:,:) = ptr_tjk( sn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 
    328                ENDIF 
    329             ENDIF 
    330  
    331             !-------------------------------------------------------- 
    332             ! overturning calculation: 
    333  
    334             ! horizontal integral and vertical dz  
    335  
    336 #if defined key_diaeiv 
    337             v_msf_glo(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:) )  
    338             IF( ln_subbas .AND. ln_diaznl ) THEN 
    339                v_msf_atl(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) )  
    340                v_msf_pac(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) )  
    341                v_msf_ind(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) )  
    342                v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) )  
    343             ENDIF 
    344 #else 
    345             v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) )  
    346             IF( ln_subbas .AND. ln_diaznl ) THEN 
    347                v_msf_atl(:,:) = ptr_vjk( vn(:,:,:), abasin(:,:)*sbasin(:,:) )  
    348                v_msf_pac(:,:) = ptr_vjk( vn(:,:,:), pbasin(:,:)*sbasin(:,:) )  
    349                v_msf_ind(:,:) = ptr_vjk( vn(:,:,:), ibasin(:,:)*sbasin(:,:) )  
    350                v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:), dbasin(:,:)*sbasin(:,:) )  
    351             ENDIF 
    352 #endif 
    353  
    354 #if defined key_diaeiv 
    355             v_msf_eiv_glo(:,:) = ptr_vjk( v_eiv(:,:,:) ) 
    356             IF (ln_subbas ) THEN  
    357                v_msf_eiv_atl(:,:) = ptr_vjk( v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 
    358                v_msf_eiv_pac(:,:) = ptr_vjk( v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 
    359                v_msf_eiv_ind(:,:) = ptr_vjk( v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 
    360                v_msf_eiv_ipc(:,:) = ptr_vjk( v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 
    361             END IF 
    362 #endif 
    363  
    364             ! Transports 
    365             ! T times V on T points (include bolus velocities) 
    366 #if defined key_diaeiv  
    367             DO jj = 2, jpj 
    368                DO ji = 1, jpi 
    369                   vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5 
    370                   vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5 
    371                END DO 
    372             END DO 
    373 #else 
    374             DO jj = 2, jpj 
    375                DO ji = 1, jpi 
    376                   vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
    377                   vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
    378                END DO 
    379             END DO 
    380 #endif  
    381             CALL lbc_lnk( vs, 'V', -1. )   ;   CALL lbc_lnk( vt, 'V', -1. ) 
    382  
    383             ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 ) 
    384             st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 ) 
    385  
    386             IF ( ln_subbas ) THEN  
    387                ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
    388                ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
    389                ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
    390                ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
    391                st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
    392                st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
    393                st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
    394                st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
    395             ENDIF 
    396  
    397             ! poleward tracer transports:  
    398             ! overturning components: 
    399             IF ( ln_ptrcomp ) THEN  
    400                pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
    401                pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 )   
    402                IF ( ln_subbas ) THEN  
    403                   pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk 
    404                   pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 )   
    405                   pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk 
    406                   pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 )   
    407                   pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk 
    408                   pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 )   
    409                   pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk 
    410                   pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 )   
    411                END IF 
    412             END IF 
    413  
    414             ! Bolus component 
    415 #if defined key_diaeiv 
    416             pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
    417             pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 )   ! SUM over jk 
    418             IF ( ln_subbas ) THEN  
    419                pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk 
    420                pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 )   ! SUM over jk 
    421                pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk 
    422                pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 )   ! SUM over jk 
    423                pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk 
    424                pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 )   ! SUM over jk 
    425                pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk 
    426                pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 )   ! SUM over jk 
    427             ENDIF 
    428 #endif 
    429  
    430             ! conversion in PW and G g 
    431             zpwatt = zpwatt * rau0 * rcp 
    432             pht_adv(:) = pht_adv(:) * zpwatt   
    433             pht_ldf(:) = pht_ldf(:) * zpwatt 
    434             pst_adv(:) = pst_adv(:) * zggram 
    435             pst_ldf(:) = pst_ldf(:) * zggram 
    436             IF ( ln_ptrcomp ) THEN  
    437                pht_ove_glo(:) = pht_ove_glo(:) * zpwatt 
    438                pst_ove_glo(:) = pst_ove_glo(:) * zggram 
    439             END IF 
    440 #if defined key_diaeiv 
    441             pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt 
    442             pst_eiv_glo(:) = pst_eiv_glo(:) * zggram 
    443 #endif 
    444             IF( ln_subbas ) THEN 
    445                ht_atl(:) = ht_atl(:) * zpwatt 
    446                ht_pac(:) = ht_pac(:) * zpwatt 
    447                ht_ind(:) = ht_ind(:) * zpwatt 
    448                ht_ipc(:) = ht_ipc(:) * zpwatt 
    449                st_atl(:) = st_atl(:) * zggram  
    450                st_pac(:) = st_pac(:) * zggram 
    451                st_ind(:) = st_ind(:) * zggram 
    452                st_ipc(:) = st_ipc(:) * zggram 
    453             ENDIF 
    454  
    455             ! "Meridional" Stream-Function 
    456             DO jk = 2,jpk  
    457                v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 
    458             END DO 
    459             v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 
    460 #if defined key_diaeiv 
    461             ! Bolus "Meridional" Stream-Function 
    462             DO jk = 2,jpk 
    463                v_msf_eiv_glo(:,jk) = v_msf_eiv_glo(:,jk-1) + v_msf_eiv_glo(:,jk) 
    464             END DO 
    465             v_msf_eiv_glo(:,:) = v_msf_eiv_glo(:,:) * zsverdrup 
    466             IF ( ln_subbas ) THEN  
    467                DO jk = 2,jpk 
    468                   v_msf_eiv_atl(:,jk) = v_msf_eiv_atl(:,jk-1) + v_msf_eiv_atl(:,jk) 
    469                   v_msf_eiv_pac(:,jk) = v_msf_eiv_pac(:,jk-1) + v_msf_eiv_pac(:,jk) 
    470                   v_msf_eiv_ind(:,jk) = v_msf_eiv_ind(:,jk-1) + v_msf_eiv_ind(:,jk) 
    471                   v_msf_eiv_ipc(:,jk) = v_msf_eiv_ipc(:,jk-1) + v_msf_eiv_ipc(:,jk) 
     254      ! 
     255      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     256      REAL(wp) ::   zv               ! local scalar 
     257      !!---------------------------------------------------------------------- 
     258      ! 
     259      IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 )   THEN 
     260         ! 
     261         IF( MOD( kt, nn_fptr ) == 0 ) THEN  
     262            ! 
     263            IF( ln_diaznl ) THEN               ! i-mean temperature and salinity 
     264               DO jn = 1, nptr 
     265                  tn_jk(:,:,jn) = ptr_tjk( tn(:,:,:), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    472266               END DO 
    473267            ENDIF 
    474 #endif 
    475268            ! 
    476             IF( ln_subbas .AND. ln_diaznl ) THEN 
    477                DO jk = 2,jpk  
    478                   v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 
    479                   v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk) 
    480                   v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk) 
    481                   v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 
     269            !                          ! horizontal integral and vertical dz  
     270            !                                ! eulerian velocity 
     271            v_msf(:,:,1) = ptr_vjk( vn(:,:,:) )  
     272            DO jn = 2, nptr 
     273               v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) )  
     274            END DO 
     275#if defined key_diaeiv 
     276            DO jn = 1, nptr                  ! bolus velocity 
     277               v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) )   ! here no btm30 for MSFeiv 
     278            END DO 
     279            !                                ! add bolus stream-function to the eulerian one 
     280            v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:) 
     281#endif 
     282            ! 
     283            !                          ! Transports 
     284            !                                ! local heat & salt transports at T-points  ( tn*mj[vn+v_eiv] ) 
     285            vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp 
     286            DO jk= 1, jpkm1 
     287               DO jj = 2, jpj 
     288                  DO ji = 1, jpi 
     289#if defined key_diaeiv  
     290                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + u_eiv(ji,jj,jk) + u_eiv(ji,jj-1,jk) ) * 0.5_wp 
     291#else 
     292                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 
     293#endif  
     294                     vt(:,jj,jk) = zv * tn(:,jj,jk) 
     295                     vs(:,jj,jk) = zv * sn(:,jj,jk) 
     296                  END DO 
    482297               END DO 
    483                v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 
    484                v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup 
    485                v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 
    486                v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 
    487             ENDIF 
     298            END DO 
     299!!gm useless as overlap areas are not used in ptr_vjk 
     300            CALL lbc_lnk( vs, 'V', -1. )   ;   CALL lbc_lnk( vt, 'V', -1. ) 
     301!!gm 
     302            !                                ! heat & salt advective transports (approximation) 
     303            htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt   ! SUM over jk + conversion 
     304            str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram 
     305            DO jn = 2, nptr  
     306               htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_pwatt   ! mask Southern Ocean 
     307               str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_ggram   ! mask Southern Ocean 
     308            END DO 
     309 
     310            IF( ln_ptrcomp ) THEN            ! overturning transport 
     311               htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt   ! SUM over jk + conversion 
     312               str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram 
     313            END IF 
     314            !                                ! Advective and diffusive transport 
     315            htr_adv(:) = htr_adv(:) * rc_pwatt        ! these are computed in tra_adv... and tra_ldf... routines  
     316            htr_ldf(:) = htr_ldf(:) * rc_pwatt        ! here just the conversion in PW and Gg 
     317            str_adv(:) = str_adv(:) * rc_ggram 
     318            str_ldf(:) = str_ldf(:) * rc_ggram 
     319 
     320#if defined key_diaeiv 
     321            DO jn = 1, nptr                  ! Bolus component 
     322               htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt   ! SUM over jk 
     323               str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram   ! SUM over jk 
     324            END DO 
     325#endif 
     326            !                                ! "Meridional" Stream-Function 
     327            DO jn = 1, nptr 
     328               DO jk = 2, jpk  
     329                  v_msf    (:,jk,jn) = v_msf    (:,jk-1,jn) + v_msf    (:,jk,jn)       ! Eulerian j-Stream-Function 
     330#if defined key_diaeiv 
     331                  v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn)       ! Bolus    j-Stream-Function 
     332 
     333#endif 
     334               END DO 
     335            END DO 
     336            v_msf    (:,:,:) = v_msf    (:,:,:) * rc_sv       ! converte in Sverdrups 
     337#if defined key_diaeiv 
     338            v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv 
     339#endif 
    488340         ENDIF 
    489341         ! 
    … …  
    503355      !! ** Purpose :   Initialization, namelist read 
    504356      !!---------------------------------------------------------------------- 
    505       INTEGER ::   inum       ! temporary logical unit 
     357      INTEGER ::   jn           ! dummy loop indices  
     358      INTEGER ::   inum, ierr   ! local integers 
    506359#if defined key_mpp_mpi 
    507360      INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
    508361#endif 
    509362      !! 
    510       NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nf_ptr, nf_ptr_wri 
    511       !!---------------------------------------------------------------------- 
    512  
    513       REWIND ( numnam )              ! Read Namelist namptr : poleward transport parameters 
    514       READ   ( numnam, namptr ) 
    515  
    516       IF(lwp) THEN                   ! Control print 
     363      NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 
     364      !!---------------------------------------------------------------------- 
     365 
     366      REWIND( numnam )                 ! Read Namelist namptr : poleward transport parameters 
     367      READ  ( numnam, namptr ) 
     368 
     369      IF(lwp) THEN                     ! Control print 
    517370         WRITE(numout,*) 
    518371         WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization' 
    519372         WRITE(numout,*) '~~~~~~~~~~~~' 
    520373         WRITE(numout,*) '   Namelist namptr : set ptr parameters' 
    521          WRITE(numout,*) '      Switch for ptr diagnostic (T) or not (F)  ln_diaptr  = ', ln_diaptr 
    522          WRITE(numout,*) '      Atl/Pac/Ind basins computation            ln_subbas  = ', ln_subbas 
    523          WRITE(numout,*) '      Frequency of computation                  nf_ptr     = ', nf_ptr 
    524          WRITE(numout,*) '      Frequency of outputs                      nf_ptr_wri = ', nf_ptr_wri 
     374         WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      ln_diaptr  = ', ln_diaptr 
     375         WRITE(numout,*) '      Overturning heat & salt transport                  ln_ptrcomp = ', ln_ptrcomp 
     376         WRITE(numout,*) '      T & S zonal mean and meridional stream function    ln_diaznl  = ', ln_diaznl  
     377         WRITE(numout,*) '      Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins      ln_subbas  = ', ln_subbas 
     378         WRITE(numout,*) '      Frequency of computation                           nn_fptr    = ', nn_fptr 
     379         WRITE(numout,*) '      Frequency of outputs                               nn_fwri    = ', nn_fwri 
    525380      ENDIF 
    526381 
    527       IF( .NOT. ln_diaptr )   RETURN 
    528        
    529       IF( lk_mpp )   CALL mpp_ini_znl      ! Define MPI communicator for zonal sum 
    530  
    531       IF( ln_subbas ) THEN                 ! load sub-basin mask 
    532          CALL iom_open( 'subbasins', inum ) 
    533          CALL iom_get( inum, jpdom_data, 'atlmsk', abasin )      ! Atlantic basin 
    534          CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin )      ! Pacific basin 
    535          CALL iom_get( inum, jpdom_data, 'indmsk', ibasin )      ! Indian basin 
    536          CALL iom_close( inum ) 
    537          dbasin(:,:) = MAX ( pbasin(:,:), ibasin(:,:) ) 
    538          sbasin(:,:) = tmask (:,:,1) 
    539          WHERE ( gphit (:,:) < -30.e0) sbasin(:,:) = 0.e0 
     382      IF( ln_subbas ) THEN   ;   nptr = 5       ! Global, Atlantic, Pacific, Indian, Indo-Pacific 
     383      ELSE                   ;   nptr = 1       ! Global only 
     384      ENDIF 
     385 
     386      rc_pwatt = rc_pwatt * rau0 * rcp          ! conversion from K.s-1 to PetaWatt 
     387 
     388      IF( .NOT. ln_diaptr ) THEN       ! diaptr not used 
     389        RETURN 
     390      ELSE                             ! Allocate the diaptr arrays 
     391         ALLOCATE( btmsk(jpi,jpj,nptr) ,                                                                      & 
     392            &      htr_adv(jpj) , str_adv(jpj) , htr_ldf(jpj) , str_ldf(jpj) , htr_ove(jpj) , str_ove(jpj),   & 
     393            &      htr(jpj,nptr) , str(jpj,nptr) ,                                                              & 
     394            &      tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) ,                         & 
     395            &      sjk  (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr)                       , STAT=ierr  ) 
     396         ! 
     397         IF( ierr > 0 ) THEN 
     398            CALL ctl_stop( 'dia_ptr_init : unable to allocate standard arrays' )   ;   RETURN 
     399         ENDIF 
     400#if defined key_diaeiv 
     401!!       IF( lk_diaeiv )   &              ! eddy induced velocity arrays 
     402            ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , v_msf_eiv(jpj,jpk,nptr) , STAT=ierr ) 
     403         ! 
     404         IF( ierr > 0 ) THEN 
     405            CALL ctl_stop( 'dia_ptr_init : unable to allocate eiv arrays' )   ;   RETURN 
     406         ENDIF 
     407#endif 
    540408      ENDIF 
    541409       
    542 !!gm CAUTION : this is only valid in fixed volume case ! 
    543  
    544       ! inverse of the ocean "zonal" v-point section 
    545       surf_jk_glo(:,:) = ptr_tjk( tmask(:,:,:) ) 
    546       surf_jk_r_glo(:,:) = 0.e0 
    547       WHERE( surf_jk_glo(:,:) /= 0.e0 )   surf_jk_r_glo(:,:) = 1.e0 / surf_jk_glo(:,:) 
     410      IF( lk_mpp )   CALL mpp_ini_znl     ! Define MPI communicator for zonal sum 
     411 
     412      IF( ln_subbas ) THEN                ! load sub-basin mask 
     413         CALL iom_open( 'subbasins', inum ) 
     414         CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
     415         CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin 
     416         CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin 
     417         CALL iom_close( inum ) 
     418         btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin 
     419         WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean 
     420         ELSE WHERE                     ;   btm30(:,:) = tmask(:,:,1) 
     421         END WHERE 
     422      ENDIF 
     423      btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean 
    548424       
    549       IF (ln_subbas) THEN 
    550          surf_jk_atl(:,:) = ptr_tjk( tmask (:,:,:), abasin(:,:) ) 
    551          surf_jk_r_atl(:,:) = 0.e0 
    552          WHERE( surf_jk_atl(:,:) /= 0.e0 )   surf_jk_r_atl(:,:) = 1.e0 / surf_jk_atl(:,:) 
    553          ! 
    554          surf_jk_pac(:,:) = ptr_tjk( tmask (:,:,:), pbasin(:,:) ) 
    555          surf_jk_r_pac(:,:) = 0.e0 
    556          WHERE( surf_jk_pac(:,:) /= 0.e0 )   surf_jk_r_pac(:,:) = 1.e0 / surf_jk_pac(:,:) 
    557          !  
    558          surf_jk_ind(:,:) = ptr_tjk( tmask (:,:,:), ibasin(:,:) ) 
    559          surf_jk_r_ind(:,:) = 0.e0 
    560          WHERE( surf_jk_ind(:,:) /= 0.e0 )   surf_jk_r_ind(:,:) = 1.e0 / surf_jk_ind(:,:) 
    561          ! 
    562          surf_jk_ipc(:,:) = ptr_tjk( tmask (:,:,:), dbasin(:,:) ) 
    563          surf_jk_r_ipc(:,:) = 0.e0 
    564          WHERE( surf_jk_ipc(:,:) /= 0.e0 )   surf_jk_r_ipc(:,:) = 1.e0 / surf_jk_ipc(:,:) 
    565       END IF 
    566  
     425      DO jn = 1, nptr 
     426         btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only 
     427      END DO 
    567428       
    568       !!---------------------------------------------------------------------- 
     429      IF( lk_vvl )   CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' ) 
     430 
     431      !                                   ! i-sum of e1v*e3v surface and its inverse 
     432      DO jn = 1, nptr 
     433         sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) ) 
     434         r1_sjk(:,:,jn) = 0._wp 
     435         WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
     436      END DO 
    569437 
    570438#if defined key_mpp_mpi  
    571       iglo (1) = jpjglo 
     439      iglo (1) = jpjglo                   ! MPP case using MPI  ('key_mpp_mpi') 
    572440      iloc (1) = nlcj 
    573441      iabsf(1) = njmppt(narea) 
    … …  
    576444      ihale(1) = nlcj - nlej 
    577445      idid (1) = 2 
    578  
    579 !-$$      IF(lwp) THEN 
    580 !-$$          WRITE(numout,*) 
    581 !-$$          WRITE(numout,*) 'dia_ptr_init :   iloc  = ', iloc  
    582 !-$$          WRITE(numout,*) '~~~~~~~~~~~~     iabsf = ', iabsf 
    583 !-$$          WRITE(numout,*) '                 ihals = ', ihals 
    584 !-$$          WRITE(numout,*) '                 ihale = ', ihale 
    585 !-$$      ENDIF  
    586  
    587       CALL flio_dom_set ( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr) 
     446      CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr ) 
    588447#else 
    589448      nidom_ptr = FLIO_DOM_NONE 
    … …  
    610469      INTEGER, SAVE, DIMENSION (jpj*jpk) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30 
    611470      INTEGER, SAVE, DIMENSION (jpj)     :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 
    612  
     471      !! 
    613472      CHARACTER (len=40)       ::   clhstnam, clop, clop_once, cl_comment   ! temporary names 
    614473      INTEGER                  ::   iline, it, itmod, ji, jj, jk            ! 
    … …  
    622481 
    623482      ! define time axis 
    624       it    = kt / nf_ptr 
     483      it    = kt / nn_fptr 
    625484      itmod = kt - nit000 + 1 
    626485       
    627 !-$$      IF(lwp) THEN 
    628 !-$$         WRITE(numout,*) 
    629 !-$$         WRITE(numout,*) 'dia_ptr_wri : kt = ', kt, 'it = ', it, ' itmod = ', itmod, ' niter = ', niter 
    630 !-$$         WRITE(numout,*) '~~~~~~~~~~~~' 
    631 !-$$      ENDIF 
    632  
    633486      ! Initialization 
    634487      ! -------------- 
    635488      IF( kt == nit000 ) THEN 
    636  
    637          niter = (nit000 - 1) / nf_ptr 
    638  
    639 !-$$         IF(lwp) THEN 
    640 !-$$            WRITE(numout,*) 
    641 !-$$            WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 
    642 !-$$            WRITE(numout,*) '~~~~~~~~~~~~' 
    643 !-$$         ENDIF 
    644  
     489         niter = ( nit000 - 1 ) / nn_fptr 
    645490         zdt = rdt 
    646491         IF( nacc == 1 )   zdt = rdtmin 
    647  
    648          ! Reference latitude 
     492         ! 
     493         IF(lwp) THEN 
     494            WRITE(numout,*) 
     495            WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 
     496            WRITE(numout,*) '~~~~~~~~~~~~' 
     497         ENDIF 
     498 
     499         ! Reference latitude (used in plots) 
    649500         ! ------------------ 
    650501         !                                           ! ======================= 
    651502         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations 
    652503            !                                        ! ======================= 
    653  
    654504            IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole 
    655505            IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole 
    … …  
    657507            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole 
    658508            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole 
    659             zphi(:) = 0.e0 
     509            zphi(:) = 0._wp 
    660510            DO ji = mi0(iline), mi1(iline)  
    661511               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain 
    … …  
    663513               IF( jp_cfg == 05 ) THEN 
    664514                  DO jj = mj0(jpjdta), mj1(jpjdta)  
    665                      zphi( jj ) = zphi(mj0(jpjdta-1)) + (zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)))/2. 
    666                      zphi( jj ) = MIN( zphi(jj), 90.) 
     515                     zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp 
     516                     zphi( jj ) = MIN( zphi(jj), 90._wp ) 
    667517                  END DO 
    668518               END IF 
    669519               IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 
    670520                  DO jj = mj0(jpjdta-1), mj1(jpjdta-1)  
    671                      zphi( jj ) = 88.5e0 
     521                     zphi( jj ) = 88.5_wp 
    672522                  END DO 
    673523                  DO jj = mj0(jpjdta  ), mj1(jpjdta  )  
    674                      zphi( jj ) = 89.5e0 
     524                     zphi( jj ) = 89.5_wp 
    675525                  END DO 
    676526               END IF 
    … …  
    680530            CALL mpp_sum( zphi, jpj, ncomm_znl )         
    681531#endif 
    682  
    683532            !                                        ! ======================= 
    684533         ELSE                                        !   OTHER configurations  
    … …  
    690539         ! Work only on westmost processor (will not work if mppini2 is used) 
    691540#if defined key_mpp_mpi 
    692          IF ( l_znl_root ) THEN  
     541         IF( l_znl_root ) THEN  
    693542#endif 
    694543            ! 
    … …  
    696545            ! ---------------- 
    697546            ! Define frequency of output and means 
    698             zsto = nf_ptr * zdt 
     547            zsto = nn_fptr * zdt 
    699548            IF( ln_mskland )   THEN    ! put 1.e+20 on land (very expensive!!) 
    700549               clop      = "ave(only(x))" 
    … …  
    705554            ENDIF 
    706555 
    707             zout = nf_ptr_wri * zdt 
    708             zfoo(:) = 0.e0 
     556            zout = nn_fwri * zdt 
     557            zfoo(:) = 0._wp 
    709558 
    710559            ! Compute julian date from starting date of the run 
    … …  
    716565            ! Requested by IPSL people, use by their postpro... 
    717566            IF(lwp) THEN 
    718                CALL dia_nam( clhstnam, nf_ptr_wri,' ' ) 
     567               CALL dia_nam( clhstnam, nn_fwri,' ' ) 
    719568               CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    720569               WRITE(inum,*) clhstnam 
    … …  
    723572#endif 
    724573 
    725             CALL dia_nam( clhstnam, nf_ptr_wri, 'diaptr' ) 
     574            CALL dia_nam( clhstnam, nn_fwri, 'diaptr' ) 
    726575            IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam 
    727576 
    728577            ! Horizontal grid : zphi() 
    729578            CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   & 
    730                1, 1, 1, jpj, niter, zjulian, zdt*nf_ptr, nhoridz, numptr, domain_id=nidom_ptr, snc4chunks=snc4set) 
     579               1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr) 
    731580            ! Vertical grids : gdept_0, gdepw_0 
    732581            CALL histvert( numptr, "deptht", "Vertical T levels",   & 
    733                "m", jpk, gdept_0, ndepidzt, "down" ) 
     582               &                   "m", jpk, gdept_0, ndepidzt, "down" ) 
    734583            CALL histvert( numptr, "depthw", "Vertical W levels",   & 
    735                "m", jpk, gdepw_0, ndepidzw, "down" ) 
     584               &                   "m", jpk, gdepw_0, ndepidzw, "down" ) 
    736585 
    737586            ! 
    738             CALL wheneq ( jpj*jpk, MIN(surf_jk_glo(:,:), 1.e0), 1, 1., ndex  , ndim  )      ! Lat-Depth 
    739             CALL wheneq ( jpj    , MIN(surf_jk_glo(:,1), 1.e0), 1, 1., ndex_h, ndim_h )     ! Lat 
    740  
    741             IF (ln_subbas) THEN 
    742                z_1 (:,1) = 1.0e0 
    743                WHERE ( gphit (jpi/2,:) .LT. -30 ) z_1 (:,1) = 0.e0 
     587            CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex  , ndim  )      ! Lat-Depth 
     588            CALL wheneq ( jpj    , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h )     ! Lat 
     589 
     590            IF( ln_subbas ) THEN 
     591               z_1(:,1) = 1._wp 
     592               WHERE ( gphit(jpi/2,:) < -30._wp )   z_1(:,1) = 0._wp 
    744593               DO jk = 2, jpk 
    745                   z_1 (:,jk) = z_1 (:,1) 
     594                  z_1(:,jk) = z_1(:,1) 
    746595               END DO 
    747  
    748                CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)         , 1.e0), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth 
    749                CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth 
    750                CALL wheneq ( jpj    , MIN(surf_jk_atl(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 
    751  
    752                CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)         , 1.e0), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth 
    753                CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth 
    754                CALL wheneq ( jpj    , MIN(surf_jk_pac(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 
    755  
    756                CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)         , 1.e0), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth 
    757                CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth 
    758                CALL wheneq ( jpj    , MIN(surf_jk_ind(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 
    759  
    760                CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)         , 1.e0), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth 
    761                CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth 
    762                CALL wheneq ( jpj    , MIN(surf_jk_ipc(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 
    763  
     596               !                       ! Atlantic (jn=2) 
     597               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)         , 1._wp), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth 
     598               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)*z_1(:,:), 1._wp), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth 
     599               CALL wheneq ( jpj    , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 
     600               !                       ! Pacific (jn=3) 
     601               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)         , 1._wp), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth 
     602               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)*z_1(:,:), 1._wp), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth 
     603               CALL wheneq ( jpj    , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 
     604               !                       ! Indian (jn=4) 
     605               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)         , 1._wp), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth 
     606               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)*z_1(:,:), 1._wp), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth 
     607               CALL wheneq ( jpj    , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 
     608               !                       ! Indo-Pacific (jn=5) 
     609               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)         , 1._wp), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth 
     610               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)*z_1(:,:), 1._wp), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth 
     611               CALL wheneq ( jpj    , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 
    764612            ENDIF 
    765  
    766613            !  
    767614#if defined key_diaeiv 
    … …  
    772619            !  Zonal mean T and S 
    773620 
    774             IF ( ln_diaznl ) THEN  
     621            IF( ln_diaznl ) THEN  
    775622               CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   & 
    776623                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    … …  
    880727            ENDIF 
    881728 
    882             CALL histend( numptr, snc4set ) 
     729            CALL histend( numptr ) 
    883730 
    884731         END IF 
    … …  
    888735 
    889736#if defined key_mpp_mpi 
    890       IF( MOD( itmod, nf_ptr ) == 0 .AND. l_znl_root ) THEN 
     737      IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN 
    891738#else 
    892       IF( MOD( itmod, nf_ptr ) == 0  ) THEN 
     739      IF( MOD( itmod, nn_fptr ) == 0  ) THEN 
    893740#endif 
    894741         niter = niter + 1 
    895742 
    896 !-$$         IF(lwp) THEN 
    897 !-$$            WRITE(numout,*) 
    898 !-$$            WRITE(numout,*) 'dia_ptr_wri : write Poleward Transports at time-step : kt = ', kt, & 
    899 !-$$               & 'it = ', it, ' itmod = ', itmod, ' niter = ', niter 
    900 !-$$            WRITE(numout,*) '~~~~~~~~~~' 
    901 !-$$            WRITE(numout,*) 
    902 !-$$         ENDIF 
    903  
    904          IF (ln_diaznl ) THEN  
    905             CALL histwrite( numptr, "zosrfglo", niter, surf_jk_glo , ndim, ndex ) 
    906             CALL histwrite( numptr, "zotemglo", niter, tn_jk_glo  , ndim, ndex ) 
    907             CALL histwrite( numptr, "zosalglo", niter, sn_jk_glo  , ndim, ndex ) 
     743         IF( ln_diaznl ) THEN  
     744            CALL histwrite( numptr, "zosrfglo", niter, sjk  (:,:,1) , ndim, ndex ) 
     745            CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1)  , ndim, ndex ) 
     746            CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1)  , ndim, ndex ) 
    908747 
    909748            IF (ln_subbas) THEN  
    910                CALL histwrite( numptr, "zosrfatl", niter, surf_jk_atl, ndim_atl, ndex_atl ) 
    911                CALL histwrite( numptr, "zosrfpac", niter, surf_jk_pac, ndim_pac, ndex_pac ) 
    912                CALL histwrite( numptr, "zosrfind", niter, surf_jk_ind, ndim_ind, ndex_ind ) 
    913                CALL histwrite( numptr, "zosrfipc", niter, surf_jk_ipc, ndim_ipc, ndex_ipc ) 
    914  
    915                CALL histwrite( numptr, "zotematl", niter, tn_jk_atl  , ndim_atl, ndex_atl ) 
    916                CALL histwrite( numptr, "zosalatl", niter, sn_jk_atl  , ndim_atl, ndex_atl ) 
    917                CALL histwrite( numptr, "zotempac", niter, tn_jk_pac  , ndim_pac, ndex_pac ) 
    918                CALL histwrite( numptr, "zosalpac", niter, sn_jk_pac  , ndim_pac, ndex_pac ) 
    919                CALL histwrite( numptr, "zotemind", niter, tn_jk_ind  , ndim_ind, ndex_ind ) 
    920                CALL histwrite( numptr, "zosalind", niter, sn_jk_ind  , ndim_ind, ndex_ind ) 
    921                CALL histwrite( numptr, "zotemipc", niter, tn_jk_ipc  , ndim_ipc, ndex_ipc ) 
    922                CALL histwrite( numptr, "zosalipc", niter, sn_jk_ipc  , ndim_ipc, ndex_ipc ) 
     749               CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl ) 
     750               CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac ) 
     751               CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind ) 
     752               CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc ) 
     753 
     754               CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2)  , ndim_atl, ndex_atl ) 
     755               CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2)  , ndim_atl, ndex_atl ) 
     756               CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3)  , ndim_pac, ndex_pac ) 
     757               CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3)  , ndim_pac, ndex_pac ) 
     758               CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4)  , ndim_ind, ndex_ind ) 
     759               CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4)  , ndim_ind, ndex_ind ) 
     760               CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5)  , ndim_ipc, ndex_ipc ) 
     761               CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5)  , ndim_ipc, ndex_ipc ) 
    923762            END IF 
    924763         ENDIF 
    925764 
    926765         ! overturning outputs: 
    927          CALL histwrite( numptr, "zomsfglo", niter, v_msf_glo, ndim, ndex ) 
     766         CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex ) 
    928767         IF( ln_subbas .AND. ln_diaznl ) THEN 
    929             CALL histwrite( numptr, "zomsfatl", niter, v_msf_atl , ndim_atl_30, ndex_atl_30 ) 
    930             CALL histwrite( numptr, "zomsfpac", niter, v_msf_pac , ndim_pac_30, ndex_pac_30 ) 
    931             CALL histwrite( numptr, "zomsfind", niter, v_msf_ind , ndim_ind_30, ndex_ind_30 ) 
    932             CALL histwrite( numptr, "zomsfipc", niter, v_msf_ipc , ndim_ipc_30, ndex_ipc_30 ) 
     768            CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 ) 
     769            CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 ) 
     770            CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 ) 
     771            CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 ) 
    933772         ENDIF 
    934773#if defined key_diaeiv 
    935          CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv_glo, ndim  , ndex   ) 
    936 #endif 
    937  
     774         CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim  , ndex   ) 
     775#endif 
    938776 
    939777         ! heat transport outputs: 
    940778         IF( ln_subbas ) THEN 
    941             CALL histwrite( numptr, "sohtatl", niter, ht_atl  , ndim_h_atl_30, ndex_h_atl_30 ) 
    942             CALL histwrite( numptr, "sohtpac", niter, ht_pac  , ndim_h_pac_30, ndex_h_pac_30 ) 
    943             CALL histwrite( numptr, "sohtind", niter, ht_ind  , ndim_h_ind_30, ndex_h_ind_30 ) 
    944             CALL histwrite( numptr, "sohtipc", niter, ht_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
    945             CALL histwrite( numptr, "sostatl", niter, st_atl  , ndim_h_atl_30, ndex_h_atl_30 ) 
    946             CALL histwrite( numptr, "sostpac", niter, st_pac  , ndim_h_pac_30, ndex_h_pac_30 ) 
    947             CALL histwrite( numptr, "sostind", niter, st_ind  , ndim_h_ind_30, ndex_h_ind_30 ) 
    948             CALL histwrite( numptr, "sostipc", niter, st_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
     779            CALL histwrite( numptr, "sohtatl", niter, htr(:,2)  , ndim_h_atl_30, ndex_h_atl_30 ) 
     780            CALL histwrite( numptr, "sohtpac", niter, htr(:,3)  , ndim_h_pac_30, ndex_h_pac_30 ) 
     781            CALL histwrite( numptr, "sohtind", niter, htr(:,4)  , ndim_h_ind_30, ndex_h_ind_30 ) 
     782            CALL histwrite( numptr, "sohtipc", niter, htr(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
     783            CALL histwrite( numptr, "sostatl", niter, str(:,2)  , ndim_h_atl_30, ndex_h_atl_30 ) 
     784            CALL histwrite( numptr, "sostpac", niter, str(:,3)  , ndim_h_pac_30, ndex_h_pac_30 ) 
     785            CALL histwrite( numptr, "sostind", niter, str(:,4)  , ndim_h_ind_30, ndex_h_ind_30 ) 
     786            CALL histwrite( numptr, "sostipc", niter, str(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
    949787         ENDIF 
    950788 
    951          CALL histwrite( numptr, "sophtadv", niter, pht_adv     , ndim_h, ndex_h ) 
    952          CALL histwrite( numptr, "sophtldf", niter, pht_ldf     , ndim_h, ndex_h ) 
    953          CALL histwrite( numptr, "sopstadv", niter, pst_adv     , ndim_h, ndex_h ) 
    954          CALL histwrite( numptr, "sopstldf", niter, pst_ldf     , ndim_h, ndex_h ) 
    955          IF ( ln_ptrcomp ) THEN  
    956             CALL histwrite( numptr, "sopstove", niter, pst_ove_glo , ndim_h, ndex_h ) 
    957             CALL histwrite( numptr, "sophtove", niter, pht_ove_glo , ndim_h, ndex_h ) 
     789         CALL histwrite( numptr, "sophtadv", niter, htr_adv     , ndim_h, ndex_h ) 
     790         CALL histwrite( numptr, "sophtldf", niter, htr_ldf     , ndim_h, ndex_h ) 
     791         CALL histwrite( numptr, "sopstadv", niter, str_adv     , ndim_h, ndex_h ) 
     792         CALL histwrite( numptr, "sopstldf", niter, str_ldf     , ndim_h, ndex_h ) 
     793         IF( ln_ptrcomp ) THEN  
     794            CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h ) 
     795            CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h ) 
    958796         ENDIF 
    959797#if defined key_diaeiv 
    960          CALL histwrite( numptr, "sophteiv", niter, pht_eiv_glo  , ndim_h, ndex_h ) 
    961          CALL histwrite( numptr, "sopsteiv", niter, pst_eiv_glo  , ndim_h, ndex_h ) 
     798         CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1)  , ndim_h, ndex_h ) 
     799         CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1)  , ndim_h, ndex_h ) 
    962800#endif 
    963801         ! 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r2287 r2399  
    4848   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4949   !! $Id$ 
    50    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    51    !!---------------------------------------------------------------------- 
    52  
     50   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     51   !!---------------------------------------------------------------------- 
    5352CONTAINS 
    5453 
    55    SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn, & 
     54   SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn,        & 
    5655      &                                 ptb, ptn, pta, kjpt   )  
    5756      !!---------------------------------------------------------------------- 
    … …  
    257256         END IF 
    258257         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    259          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   
    260            IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
    261            IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
     258         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
     259           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
     260           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
    262261         ENDIF 
    263262         ! 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r2333 r2399  
    4040   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4141   !! $Id$  
    42    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    43    !!---------------------------------------------------------------------- 
    44  
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     43   !!---------------------------------------------------------------------- 
    4544CONTAINS 
    4645 
    4746   SUBROUTINE tra_adv_muscl( kt, cdtype, p2dt, pun, pvn, pwn, & 
    48       &                                        ptb, pta, kjpt   ) 
     47      &                                        ptb, pta, kjpt ) 
    4948      !!---------------------------------------------------------------------- 
    5049      !!                    ***  ROUTINE tra_adv_muscl  *** 
    … …  
    179178         END IF 
    180179         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    181          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   
    182             IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
    183             IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
     180         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
     181            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
     182            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
    184183         ENDIF 
    185184 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r2333 r2399  
    3838   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3939   !! $Id$  
    40    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    41    !!---------------------------------------------------------------------- 
    42  
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
    4342CONTAINS 
    4443 
    45    SUBROUTINE tra_adv_muscl2( kt, cdtype, p2dt, pun, pvn, pwn, & 
    46       &                                         ptb, ptn, pta, kjpt   ) 
     44   SUBROUTINE tra_adv_muscl2( kt, cdtype, p2dt, pun, pvn, pwn,      & 
     45      &                                         ptb, ptn, pta, kjpt ) 
    4746      !!---------------------------------------------------------------------- 
    4847      !!                   ***  ROUTINE tra_adv_muscl2  *** 
    … …  
    201200 
    202201         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    203          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    204             IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
    205             IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
     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(:,:,:) ) 
    206205         ENDIF 
    207206 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r2287 r2399  
    4141   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4242   !! $Id$ 
    43    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 
    45  
    4645CONTAINS 
    4746 
    48    SUBROUTINE tra_adv_qck ( kt, cdtype, p2dt, pun, pvn, pwn, & 
    49       &                                       ptb, ptn, pta, kjpt   ) 
     47   SUBROUTINE tra_adv_qck ( kt, cdtype, p2dt, pun, pvn, pwn,      & 
     48      &                                       ptb, ptn, pta, kjpt ) 
    5049      !!---------------------------------------------------------------------- 
    5150      !!                  ***  ROUTINE tra_adv_qck  *** 
    … …  
    8281      !! ** Reference : Leonard (1979, 1991) 
    8382      !!---------------------------------------------------------------------- 
    84       !! 
    8583      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    8684      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    112110 
    113111 
    114    SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun,    & 
     112   SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun,                  & 
    115113      &                                        ptb, ptn, pta, kjpt   ) 
    116114      !!---------------------------------------------------------------------- 
    … …  
    152150         END DO 
    153151         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions  
    154  
    155152          
    156153         ! 
    … …  
    231228 
    232229 
    233    SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn,   & 
    234       &                                        ptb, ptn, pta, kjpt   ) 
    235       !!---------------------------------------------------------------------- 
    236       !! 
    237       !!---------------------------------------------------------------------- 
    238       !! 
     230   SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn,                & 
     231      &                                        ptb, ptn, pta, kjpt ) 
     232      !!---------------------------------------------------------------------- 
     233      !! 
     234      !!---------------------------------------------------------------------- 
    239235      USE oce         , zwy => ua   ! use ua as workspace 
    240236      !! 
    … …  
    312308               DO ji = fs_2, fs_jpim1   ! vector opt.                
    313309                  zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    314                ENDDO 
     310               END DO 
    315311            END DO 
    316312         END DO 
    … …  
    347343         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    348344         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    349          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   
    350            IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
    351            IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
     345         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
     346           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
     347           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
    352348         ENDIF 
    353349         ! 
    … …  
    357353 
    358354 
    359    SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn,   & 
     355   SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn,           & 
    360356     &                                    ptn, pta, kjpt ) 
    361357      !!---------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r2333 r2399  
    4747   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4848   !! $Id$ 
    49    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    50    !!---------------------------------------------------------------------- 
    51  
     49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     50   !!---------------------------------------------------------------------- 
    5251CONTAINS 
    5352 
    54    SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn,   & 
    55       &                                       ptb, ptn, pta, kjpt   ) 
     53   SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn,      & 
     54      &                                       ptb, ptn, pta, kjpt ) 
    5655      !!---------------------------------------------------------------------- 
    5756      !!                  ***  ROUTINE tra_adv_tvd  *** 
    … …  
    169168         END IF 
    170169         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    171          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   
    172            IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
    173            IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
     170         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
     171           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
     172           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
    174173         ENDIF 
    175174 
    … …  
    231230         END IF 
    232231         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    233          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   
    234            IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) ) + pht_adv(:) 
    235            IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) ) + pst_adv(:) 
     232         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
     233           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:) 
     234           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:) 
    236235         ENDIF 
    237236         ! 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r2287 r2399  
    3636   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3737   !! $Id$ 
    38    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    39    !!---------------------------------------------------------------------- 
    40  
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    4140CONTAINS 
    4241 
    43    SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn,   & 
    44       &                                       ptb, ptn, pta, kjpt   ) 
     42   SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn,      & 
     43      &                                       ptb, ptn, pta, kjpt ) 
    4544      !!---------------------------------------------------------------------- 
    4645      !!                  ***  ROUTINE tra_adv_ubs  *** 
    … …  
    183182         END IF 
    184183         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    185          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   
    186             IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
    187             IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
     184         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
     185            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
     186            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
    188187         ENDIF 
    189188          

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r2371 r2399  
    4747   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4848   !! $Id$  
    49    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    50    !!---------------------------------------------------------------------- 
    51  
     49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     50   !!---------------------------------------------------------------------- 
    5251CONTAINS 
    5352 
    … …  
    5756      !!  
    5857      !! ** Purpose :   compute the lateral ocean tracer physics. 
    59       !! 
    6058      !!---------------------------------------------------------------------- 
    6159      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    … …  
    7068 
    7169      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    72       CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian 
    73       CASE ( 1 )     
    74          IF ( ln_traldf_grif ) THEN 
    75  
    76             CALL tra_ldf_iso_grif    ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0  )           ! Griffies quarter-cell formulation 
    77          ELSE 
    78             CALL tra_ldf_iso   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )  ! rotated laplacian 
    79          ENDIF 
    80       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian 
    81       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRA',             tsb, tsa, jpts        )  ! s-coord. horizontal bilap. 
     70      CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian 
     71      CASE ( 1 )                                                                              ! rotated laplacian 
     72         IF( ln_traldf_grif ) THEN                                                           
     73                       CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator 
     74         ELSE                                                                                 
     75                       CALL tra_ldf_iso     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Madec operator 
     76         ENDIF 
     77      CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian 
     78      CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap. 
    8279         ! 
    83       CASE ( -1 )                                     ! esopa: test all possibility with control print 
     80      CASE ( -1 )                                ! esopa: test all possibility with control print 
    8481         CALL tra_ldf_lap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  
    8582         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               & 
    8683         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    87          IF ( ln_traldf_grif ) THEN 
    88             CALL tra_ldf_iso_grif    ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 
     84         IF( ln_traldf_grif ) THEN 
     85            CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 
    8986         ELSE 
    90             CALL tra_ldf_iso   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )   
     87            CALL tra_ldf_iso     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )   
    9188         ENDIF 
    9289         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               & 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r2287 r2399  
    4242   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4343   !! $Id$ 
    44    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     44   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
    46  
    4746CONTAINS 
    4847  
    49    SUBROUTINE tra_ldf_bilap( kt, cdtype, pgu, pgv,  & 
     48   SUBROUTINE tra_ldf_bilap( kt, cdtype, pgu, pgv,      & 
    5049      &                                  ptb, pta, kjpt )   
    5150      !!---------------------------------------------------------------------- 
    … …  
    7473      !!               biharmonic mixing trend. 
    7574      !!---------------------------------------------------------------------- 
    76       !! 
    7775      USE oce         , ztu => ua   ! use ua as workspace 
    7876      USE oce         , ztv => va   ! use va as workspace 
    … …  
    159157         !                                                 
    160158         ! "zonal" mean lateral diffusive heat and salt transport 
    161          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   
    162            IF( jn == jp_tem )  pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    163            IF( jn == jp_sal )  pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     159         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
     160           IF( jn == jp_tem )  htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     161           IF( jn == jp_sal )  str_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    164162         ENDIF 
    165163         !                                                ! =========== 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r2287 r2399  
    44   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!============================================================================== 
    6    !! History : 8.0   !  1997-07  (G. Madec)  Original code 
    7    !!           NEMO  ! 2002-08  (G. Madec)  F90: Free form and module 
    8    !!           3.3   !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC 
     6   !! History : 8.0   ! 1997-07  (G. Madec)  Original code 
     7   !!   NEMO    1.0   ! 2002-08  (G. Madec)  F90: Free form and module 
     8   !!           3.3   ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC 
    99   !!============================================================================== 
    1010#if defined key_ldfslp   ||   defined key_esopa 
    … …  
    3737   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3838   !! $Id$ 
    39    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    40    !!---------------------------------------------------------------------- 
    41     
     39   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     40   !!---------------------------------------------------------------------- 
    4241CONTAINS 
    4342 
    … …  
    6665      !!               biharmonic mixing trend. 
    6766      !!---------------------------------------------------------------------- 
    68       INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index 
    69       CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator) 
    70       INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers 
    71       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb          ! before and now tracer fields 
    72       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta          ! tracer trend  
     67      INTEGER         , INTENT(in   )                      ::   kt       ! ocean time-step index 
     68      CHARACTER(len=3), INTENT(in   )                      ::   cdtype   ! =TRA or TRC (tracer indicator) 
     69      INTEGER         , INTENT(in   )                      ::   kjpt     ! number of tracers 
     70      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
    7372      !! 
    7473      INTEGER ::   ji, jj, jk, jn                 ! dummy loop indices 
    … …  
    8180         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    8281      ENDIF 
    83       ! 
    84       ! 
    8582 
    8683      ! 1. Laplacian of ptb * aht 
    … …  
    10097      ! 3. Update the tracer trends                    (j-slab :   2, jpj-1) 
    10198      ! --------------------------- 
    102       ! 
    10399      DO jn = 1, kjpt 
    104          !                                                ! =============== 
    105          DO jj = 2, jpjm1                                 !  Vertical slab 
    106             !                                             ! =============== 
     100         DO jj = 2, jpjm1 
    107101            DO jk = 1, jpkm1 
    108102               DO ji = 2, jpim1 
    … …  
    111105               END DO 
    112106            END DO 
    113             !                                             ! =============== 
    114          END DO                                           !   End of slab 
    115          !                                                ! =============== 
     107         END DO 
    116108      END DO 
    117  
     109      ! 
    118110   END SUBROUTINE tra_ldf_bilapg 
    119111 
    … …  
    238230         !                                                ! =============== 
    239231         ! "Poleward" diffusive heat or salt transport 
    240          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    241             IF( jn == jp_tem)   pht_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    242             IF( jn == jp_sal)   pst_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     232         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     233            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     234            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    243235         ENDIF 
    244236 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r2287 r2399  
    4545   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4646   !! $Id$ 
    47    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    48    !!---------------------------------------------------------------------- 
    49  
     47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     48   !!---------------------------------------------------------------------- 
    5049CONTAINS 
    5150 
    52    SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv,  & 
     51   SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv,              & 
    5352      &                                ptb, pta, kjpt, pahtb0 ) 
    5453      !!---------------------------------------------------------------------- 
    … …  
    209208         ! 
    210209         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    211          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    212             IF( jn == jp_tem)   pht_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    213             IF( jn == jp_sal)   pst_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     210         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     211            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     212            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    214213         ENDIF 
    215214  

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r2371 r2399  
    4747   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4848   !! $Id$ 
    49    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    50    !!---------------------------------------------------------------------- 
    51  
     49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     50   !!---------------------------------------------------------------------- 
    5251CONTAINS 
    5352 
    54   SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv,  & 
    55        &                                ptb, pta, kjpt, pahtb0 ) 
     53  SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv,              & 
     54       &                                   ptb, pta, kjpt, pahtb0 ) 
    5655    !!---------------------------------------------------------------------- 
    5756    !!                  ***  ROUTINE tra_ldf_iso_grif  *** 
    … …  
    316315       ! 
    317316       !                            ! "Poleward" diffusive heat or salt transports (T-S case only) 
    318        IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    319          IF( jn == jp_tem)   pht_ldf(:) = ptr_vj( zftv(:,:,:) )        ! 3.3  names 
    320          IF( jn == jp_sal)   pst_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     317       IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     318         IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )        ! 3.3  names 
     319         IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    321320       ENDIF 
    322321 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r2287 r2399  
    3939   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4040   !! $Id$ 
    41    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 
    43     
    4443CONTAINS 
    4544 
    46    SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv,   & 
     45   SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv,      & 
    4746      &                                ptb, pta, kjpt )  
    4847      !!---------------------------------------------------------------------- 
    … …  
    134133         ! 
    135134         ! "Poleward" diffusive heat or salt transports 
    136          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    137             IF( jn  == jp_tem)   pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    138             IF( jn  == jp_sal)   pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     135         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     136            IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     137            IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    139138         ENDIF 
    140139         !                                                  ! ================== 
Note: See TracChangeset for help on using the changeset viewer.