Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 3211)
@@ -75,4 +75,9 @@
 
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment
+
+   !! * Control permutation of array indices
+#  include "asminc_ftrans.h90"
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -409,5 +414,9 @@
             CALL iom_get( inum, jpdom_autoglo, 'bckineta', ssh_bkginc, 1 )
             ! Apply the masks
+#if defined key_z_first
+            ssh_bkginc(:,:) = ssh_bkginc(:,:) * tmask_1(:,:)
+#else
             ssh_bkginc(:,:) = ssh_bkginc(:,:) * tmask(:,:,1)
+#endif
             ! Set missing increments to 0.0 rather than 1e+20
             ! to allow for differences in masks
@@ -472,5 +481,9 @@
          IF ( ln_sshinc ) THEN
             CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh_bkg )
+#if defined key_z_first
+            ssh_bkg(:,:) = ssh_bkg(:,:) * tmask_1(:,:)
+#else
             ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1)
+#endif
          ENDIF
 
@@ -620,14 +633,31 @@
 
             ! Update the tracer tendencies
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  DO jk = 1, jpkm1
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + t_bkginc(ji,jj,jk) * zincwgt  
+                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + s_bkginc(ji,jj,jk) * zincwgt
+                  END DO
+               END DO
+            END DO
+#else
             DO jk = 1, jpkm1
                tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt  
                tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt
             END DO
+#endif
 
             ! Salinity fix
             IF (ln_salfix) THEN
+#if defined key_z_first
+               DO jj = 1, jpj
+                  DO ji= 1, jpi
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpj
                      DO ji= 1, jpi
+#endif
                         tsa(ji,jj,jk,jp_sal) = MAX( tsa(ji,jj,jk,jp_sal), salfixmin )
                      END DO
@@ -660,7 +690,13 @@
             ! Optional salinity fix
             IF (ln_salfix) THEN
+#if defined key_z_first
+               DO jj = 1, jpj
+                  DO ji= 1, jpi
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpj
                      DO ji= 1, jpi
+#endif
                         tsn(ji,jj,jk,jp_sal) = MAX( tsn(ji,jj,jk,jp_sal), salfixmin )
                      END DO
@@ -702,4 +738,7 @@
       !
       INTEGER :: jk
+#if defined key_z_first
+      INTEGER :: ji, jj
+#endif
       INTEGER :: it
       REAL(wp) :: zincwgt  ! IAU weight for current time step
@@ -725,8 +764,20 @@
 
             ! Update the dynamic tendencies
+
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  DO jk = 1, jpkm1
+                     ua(ji,jj,jk) = ua(ji,jj,jk) + u_bkginc(ji,jj,jk) * zincwgt
+                     va(ji,jj,jk) = va(ji,jj,jk) + v_bkginc(ji,jj,jk) * zincwgt
+                  END DO
+               END DO
+            END DO
+#else
             DO jk = 1, jpkm1
                ua(:,:,jk) = ua(:,:,jk) + u_bkginc(:,:,jk) * zincwgt
                va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt
             END DO
+#endif
            
             IF ( kt == nitiaufin_r ) THEN
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asminc_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asminc_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asminc_ftrans.h90	(revision 3211)
@@ -0,0 +1,27 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  asminc_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : FTRANS directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   asminc.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS t_bkg :I :I :z
+!FTRANS s_bkg :I :I :z
+!FTRANS u_bkg :I :I :z
+!FTRANS v_bkg :I :I :z
+!FTRANS t_bkginc :I :I :z 
+!FTRANS s_bkginc :I :I :z 
+!FTRANS u_bkginc :I :I :z 
+!FTRANS v_bkginc :I :I :z 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90	(revision 3211)
@@ -50,4 +50,16 @@
    PUBLIC   asm_trj_wri   !: Write out the background state
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "tradmp_ftrans.h90"
+#if defined key_zdftke
+#  include "zdftke_ftrans.h90"
+#endif
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 3211)
@@ -41,5 +41,5 @@
    !
    INTEGER ::   nn_rimwidth = 7       !: boundary rim width
-   INTEGER ::   nn_dtactl   = 1	     !: = 0 use the initial state as bdy dta ; = 1 read it in a NetCDF file
+   INTEGER ::   nn_dtactl   = 1       !: = 0 use the initial state as bdy dta ; = 1 read it in a NetCDF file
    INTEGER ::   nn_volctl   = 1       !: = 0 the total volume will have the variability of the surface Flux E-P 
    !                                  !  = 1 the volume will be constant during all the integration.
@@ -63,5 +63,5 @@
    INTEGER, DIMENSION(jpbdim,jpbgrd) ::   nbmap           !: Indices of data in file for data in memory 
     
-   REAL(wp) ::   bdysurftot	                            !: Lateral surface of unstructured open boundary
+   REAL(wp) ::   bdysurftot                               !: Lateral surface of unstructured open boundary
 
    REAL(wp), DIMENSION(jpbdim)        ::   flagu, flagv   !: Flag for normal velocity compnt for velocity components
@@ -71,5 +71,5 @@
    REAL(wp), DIMENSION(jpbdim)     ::   ubtbdy, vbtbdy    !: Now clim of bdy barotropic velocity components
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tbdy  , sbdy      !: Now clim of bdy temperature and salinity  
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubdy  , vbdy	  !: Now clim of bdy velocity components
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubdy  , vbdy      !: Now clim of bdy velocity components
    REAL(wp), DIMENSION(jpbdim) ::   sshtide               !: Tidal boundary array : SSH
    REAL(wp), DIMENSION(jpbdim) ::   utide, vtide          !: Tidal boundary array : U and V
@@ -79,4 +79,7 @@
    REAL(wp), DIMENSION(jpbdim) ::   hsnif_bdy   !: now snow thickness
 #endif
+
+   !! * Control permutation of array indices
+   !!   We do not permute indices of boundary condition arrays!
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90	(revision 3211)
@@ -20,5 +20,5 @@
    INTEGER, PUBLIC, PARAMETER ::   jpbdim  = 20000    !: Max length of bdy field on a processor
    INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000     !: Max number of time dumps per file
-   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 6	      !: Number of horizontal grid types used  (T, u, v, f)
+   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 6        !: Number of horizontal grid types used  (T, u, v, f)
 #else
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 3211)
@@ -58,4 +58,8 @@
    REAL(wp), DIMENSION(jpbdim,2)     ::   hsnif_bdydta         ! }
 #endif
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -114,4 +118,5 @@
       REAL(wp) ::   dayjul0, zdayjulini
       REAL(wp), DIMENSION(jpbtime)      ::   zstepr             ! REAL time array from data files
+!! DCSE_NEMO: do not ftrans! Beware!
       REAL(wp), DIMENSION(jpbdta,1,jpk) ::   zdta               ! temporary array for data fields
       !!---------------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 3211)
@@ -35,4 +35,8 @@
 # endif
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -133,5 +137,5 @@
       ! Flather boundary conditions     :!
       ! ---------------------------------! 
-     
+
       IF(ln_dyn_fla .OR. ln_tides) THEN ! If these are both false, then this routine does nothing. 
 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice.F90	(revision 3211)
@@ -25,4 +25,8 @@
 
    PUBLIC   bdy_ice_frs    ! routine called in sbcmod
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 3211)
@@ -32,4 +32,8 @@
 
    PUBLIC   bdy_init   ! routine called by opa.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -336,7 +340,13 @@
       ! Mask corrections
       ! ----------------
+#if defined key_z_first
+      DO ij = 1, jpj
+         DO ii = 1, jpi
+            DO ik = 1, jpkm1
+#else
       DO ik = 1, jpkm1
          DO ij = 1, jpj
             DO ii = 1, jpi
+#endif
                tmask(ii,ij,ik) = tmask(ii,ij,ik) * bdytmask(ii,ij)
                umask(ii,ij,ik) = umask(ii,ij,ik) * bdyumask(ii,ij)
@@ -347,7 +357,13 @@
       END DO
 
+#if defined key_z_first
+      DO ij = 2, jpjm1
+         DO ii = 2, jpim1
+            DO ik = 1, jpkm1
+#else
       DO ik = 1, jpkm1
          DO ij = 2, jpjm1
             DO ii = 2, jpim1
+#endif
                fmask(ii,ij,ik) = fmask(ii,ij,ik) * bdytmask(ii,ij  ) * bdytmask(ii+1,ij  )   &
                   &                              * bdytmask(ii,ij+1) * bdytmask(ii+1,ij+1)
@@ -356,6 +372,11 @@
       END DO
 
+#if defined key_z_first
+      bdytmask(:,:) = tmask(:,:,1)
+      tmask_i (:,:) = bdytmask(:,:) * tmask_i(:,:)             
+#else
       tmask_i (:,:) = tmask(:,:,1) * tmask_i(:,:)             
       bdytmask(:,:) = tmask(:,:,1)
+#endif
 
       ! bdy masks and bmask are now set to zero on boundary points:
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 3211)
@@ -54,4 +54,8 @@
    REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   u1  , u2     ! Tidal constituents : U
    REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   v1  , v2     ! Tidal constituents : V
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
    
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 3211)
@@ -23,4 +23,8 @@
 
    PUBLIC bdy_tra_frs     ! routine called in tranxt.F90 
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 3211)
@@ -26,4 +26,9 @@
 
    PUBLIC bdy_vol        ! routine called by dynspg_flt.h90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 3211)
@@ -25,4 +25,8 @@
    PUBLIC   cor_c1d      ! routine called by OPA.F90
    PUBLIC   dyn_cor_c1d  ! routine called by step1d.F90
+
+   !! * Array index permutations
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
@@ -96,7 +100,13 @@
       ENDIF
       !
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                ua(ji,jj,jk) = ua(ji,jj,jk) + ff(ji,jj) * vn(ji,jj,jk)
                va(ji,jj,jk) = va(ji,jj,jk) - ff(ji,jj) * un(ji,jj,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 3211)
@@ -23,4 +23,7 @@
 
    PUBLIC dyn_nxt_c1d                ! routine called by step.F90
+   !! * Array index permutations
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
    !!----------------------------------------------------------------------
    !! NEMO/C1D 3.3 , NEMO Consortium (2010)
@@ -51,5 +54,9 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !!
+#if defined key_z_first
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+#else
       INTEGER  ::   jk           ! dummy loop indices
+#endif
       REAL(wp) ::   z2dt         ! temporary scalar
       !!----------------------------------------------------------------------
@@ -66,9 +73,43 @@
       CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )      ! Lateral boundary conditions
 
+#if defined key_z_first
+      DO jj = 1, jpj                                                       ! Next Velocity
+         DO ji = 1, jpi 
+            DO jk = 1, jpkm1
+               ua(ji,jj,jk) = ( ub(ji,jj,jk) + z2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk)
+               va(ji,jj,jk) = ( vb(ji,jj,jk) + z2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO 
+#else
       DO jk = 1, jpkm1                                                     ! Next Velocity
          ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)
          va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)
       END DO 
+#endif
  
+#if defined key_z_first
+      IF( neuler == 0 .AND. kt == nit000 ) THEN                            ! Euler (forward) time stepping
+         DO jj = 1, jpj                                                    ! Time filter and swap of dynamics arrays
+            DO ji = 1, jpi
+               ub(ji,jj,1:jpkm1) = un(ji,jj,1:jpkm1)
+               vb(ji,jj,1:jpkm1) = vn(ji,jj,1:jpkm1)
+               un(ji,jj,1:jpkm1) = ua(ji,jj,1:jpkm1)
+               vn(ji,jj,1:jpkm1) = va(ji,jj,1:jpkm1)
+            END DO
+         END DO
+      ELSE                                                                ! Leap-frog time stepping
+         DO jj =1 , jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  ub(ji,jj,jk) = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk)
+                  vb(ji,jj,jk) = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk)
+                  un(ji,jj,jk) = ua(ji,jj,jk)
+                  vn(ji,jj,jk) = va(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+#else
       DO jk = 1, jpkm1                                                     ! Time filter and swap of dynamics arrays
          IF( neuler == 0 .AND. kt == nit000 ) THEN                               ! Euler (forward) time stepping
@@ -84,4 +125,5 @@
          ENDIF
       END DO
+#endif
 
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt_c1d  - Un: ', mask1=umask,   &
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 3211)
@@ -24,4 +24,8 @@
 
    PUBLIC stp_c1d      ! called by opa.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
@@ -53,5 +57,9 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
-      INTEGER ::   jk       ! dummy loop indice
+#if defined key_z_first
+      INTEGER ::   ji, jj, jk         ! dummy loop indices
+#else
+      INTEGER ::   jk                 ! dummy loop index
+#endif
       INTEGER ::   indic    ! error indicator if < 0
       !! ---------------------------------------------------------------------
@@ -87,5 +95,15 @@
 
       IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 2, nkrnf
+                  avt(ji,jj,jk) = avt(ji,jj,jk) + 2.e0 * rn_avt_rnf * rnfmsk(ji,jj)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:)   ;   END DO
+#endif
       ENDIF
       IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 3211)
@@ -7,4 +7,5 @@
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!----------------------------------------------------------------------
+
 #if defined key_diaar5   || defined key_esopa
    !!----------------------------------------------------------------------
@@ -17,5 +18,5 @@
    USE dom_oce        ! ocean space and time domain
    USE eosbn2         ! equation of state                (eos_bn2 routine)
-   USE lib_mpp        ! distribued memory computing library
+   USE lib_mpp        ! distributed memory computing library
    USE iom            ! I/O manager library
 
@@ -35,4 +36,9 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity
       
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+!FTRANS sn0 :I :I :z
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -69,4 +75,9 @@
       USE wrk_nemo, ONLY:   zrhd      => wrk_3d_1 , zrhop    => wrk_3d_2   ! 3D      -
       USE wrk_nemo, ONLY:   ztsn      => wrk_4d_1                          ! 4D      -
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zrhd zrhop :I :I :z
+!FTRANS ztsn :I :I :z :
+
       !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
@@ -99,8 +110,18 @@
       CALL eos( ztsn, zrhd )                       ! now in situ density using initial salinity
       !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zbotpres(ji,jj) = 0._wp                ! no atmospheric surface pressure, levitating sea-ice
+            DO jk = 1, jpkm1
+               zbotpres(ji,jj) = zbotpres(ji,jj) + fse3t(ji,jj,jk) * zrhd(ji,jj,jk)
+            END DO
+      END DO
+#else
       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
       DO jk = 1, jpkm1
          zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
       END DO
+#endif
       IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
       !                                         
@@ -115,8 +136,18 @@
       CALL iom_put( 'rhop', zrhop )
       !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zbotpres(ji,jj) = 0._wp                ! no atmospheric surface pressure, levitating sea-ice
+            DO jk = 1, jpkm1
+               zbotpres(ji,jj) = zbotpres(ji,jj) + fse3t(ji,jj,jk) * zrhd(ji,jj,jk)
+            END DO
+      END DO
+#else
       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
       DO jk = 1, jpkm1
          zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
       END DO
+#endif
       IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
       !    
@@ -134,7 +165,13 @@
       ztemp = 0._wp
       zsal  = 0._wp
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                zztmp = area(ji,jj) * fse3t(ji,jj,jk)
                ztemp = ztemp + zztmp * tn(ji,jj,jk)
@@ -166,4 +203,8 @@
    END SUBROUTINE dia_ar5
 
+   !! * Reset control of array index permutation
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+!FTRANS sn0 :I :I :z
 
    SUBROUTINE dia_ar5_init
@@ -181,4 +222,5 @@
       REAL(wp) ::   zztmp  
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity
+!FTRANS zsaldta :I :I :z :
       !!----------------------------------------------------------------------
       !
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90	(revision 3211)
@@ -22,4 +22,8 @@
    REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d    ! 2d temporary workspace (sp)
    REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:)   :: z4dep   ! vertical level (sp)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 3211)
@@ -33,4 +33,10 @@
       &                        a_sshb, a_sshn, a_salb, a_saln
    REAL(wp), DIMENSION(4) ::   a_flxi, a_flxo, a_temi, a_temo, a_sali, a_salo
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 3211)
@@ -19,5 +19,8 @@
    USE trabbc          ! bottom boundary condition
    USE bdy_par         ! (for lk_bdy)
-   USE obc_par         ! (for lk_obc)
+
+!! DCSE_NEMO:
+!  USE obc_par         ! (for lk_obc)
+   USE obc_par, ONLY: lk_obc         ! (for lk_obc)
 
    IMPLICIT NONE
@@ -37,4 +40,11 @@
    REAL(dp), DIMENSION(:,:)  , ALLOCATABLE ::   surf      , ssh_ini              !
    REAL(dp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  !
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+!FTRANS hc_loc_ini sc_loc_ini e3t_ini :I :I :z
 
    !! * Substitutions
@@ -64,5 +74,5 @@
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !!
-      INTEGER    ::   jk                          ! dummy loop indice
+      INTEGER    ::   ji, jj, jk                  ! dummy loop indices
       REAL(dp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations
       REAL(dp)   ::   zdiff_v1    , zdiff_v2      ! volume variation
@@ -98,4 +108,26 @@
       zdiff_hc = 0.d0
       zdiff_sc = 0.d0
+#if defined key_z_first
+      ! volume variation (calculated with ssh)
+      zdiff_v1 = SUM( surf(:,:) * tmask_1(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               ! volume variation (calculated with scale factors)
+               zdiff_v2 = zdiff_v2 + ( surf(ji,jj) * tmask(ji,jj,jk)    &
+                  &                       * ( fse3t_n(ji,jj,jk)         &
+                  &                           - e3t_ini(ji,jj,jk) ) ) 
+               ! heat content variation
+               zdiff_hc = zdiff_hc + ( surf(ji,jj) * tmask(ji,jj,jk)             &
+                  &                       * ( fse3t_n(ji,jj,jk) * tn(ji,jj,jk)   &
+                  &                           - hc_loc_ini(ji,jj,jk) ) )
+               ! salt content variation
+               zdiff_sc = zdiff_sc + ( surf(ji,jj) * tmask(ji,jj,jk)             &
+                  &                       * ( fse3t_n(ji,jj,jk) * sn(ji,jj,jk)   &
+                  &                           - sc_loc_ini(ji,jj,jk) ) )
+            END DO
+         END DO
+      END DO
+#else
       ! volume variation (calculated with ssh)
       zdiff_v1 = SUM( surf(:,:) * tmask(:,:,1) * ( sshn(:,:) - ssh_ini(:,:) ) )
@@ -114,5 +146,5 @@
             &                           - sc_loc_ini(:,:,jk) ) )
       ENDDO
-
+#endif
       IF( lk_mpp ) THEN
          CALL mpp_sum( zdiff_hc )
@@ -156,7 +188,7 @@
       !!             - Compute coefficients for conversion
       !!---------------------------------------------------------------------------
-      CHARACTER (len=32) ::   cl_name  ! output file name
-      INTEGER            ::   jk       ! dummy loop indice
-      INTEGER            ::   ierror   ! local integer
+      CHARACTER (len=32) ::   cl_name      ! output file name
+      INTEGER            ::   ji, jj, jk   ! dummy loop indices
+      INTEGER            ::   ierror       ! local integer
       !!
       NAMELIST/namhsb/ ln_diahsb
@@ -209,5 +241,9 @@
       ENDIF
       cl_name    = 'heat_salt_volume_budgets.txt'                         ! name of output file
+#if defined key_z_first
+      surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_1(:,:) * tmask_i(:,:)      ! masked surface grid cell area
+#else
       surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area
+#endif
       surf_tot  = SUM( surf(:,:) )                                       ! total ocean surface area
       vol_tot   = 0.d0                                                   ! total ocean volume
@@ -249,4 +285,13 @@
       ! ---------------------------------- !
       ssh_ini(:,:) = sshn(:,:)                               ! initial ssh
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            e3t_ini   (ji,jj,:) = fse3t_n(ji,jj,:)                 ! initial vertical scale factors
+            hc_loc_ini(ji,jj,:) = tn(ji,jj,:) * fse3t_n(ji,jj,:)   ! initial heat content
+            sc_loc_ini(ji,jj,:) = sn(ji,jj,:) * fse3t_n(ji,jj,:)   ! initial salt content
+         END DO
+      END DO
+#else
       DO jk = 1, jpk
          e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                ! initial vertical scale factors
@@ -254,4 +299,5 @@
          sc_loc_ini(:,:,jk) = sn(:,:,jk) * fse3t_n(:,:,jk)   ! initial salt content
       END DO
+#endif
       frc_v = 0.d0                                           ! volume       trend due to forcing
       frc_t = 0.d0                                           ! heat content   -    -   -    -   
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 3211)
@@ -36,4 +36,8 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28   !: depth of 28 C isotherm                         [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3   !: heat content of first 300 m                    [W]
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
@@ -179,7 +183,13 @@
       ! MLD: rho = rho(1) + zrho1                                     !
       ! ------------------------------------------------------------- !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = jpkm1, 2, -1   ! loop from bottom to 2
+#else
       DO jk = jpkm1, 2, -1   ! loop from bottom to 2
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                !
                zzdep = fsdepw(ji,jj,jk)
@@ -215,7 +225,13 @@
       ! depth of temperature inversion                                !
       ! ------------------------------------------------------------- !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = jpkm1, nlb10, -1   ! loop from bottom to nlb10
+#else
       DO jk = jpkm1, nlb10, -1   ! loop from bottom to nlb10
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                !
                zzdep = fsdepw(ji,jj,jk) * tmask(ji,jj,1)
@@ -251,7 +267,14 @@
       ik20(:,:) = 1
       ik28(:,:) = 1
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1   ! beware temperature is not always decreasing with depth => 
+               !               ! loop from top to bottom
+#else
       DO jk = 1, jpkm1   ! beware temperature is not always decreasing with depth => loop from top to bottom
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                zztmp = tn(ji,jj,jk)
                IF( zztmp >= 20. )   ik20(ji,jj) = jk
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 3211)
@@ -21,4 +21,7 @@
 
    PUBLIC dia_nam
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 3211)
@@ -80,4 +80,9 @@
    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -138,5 +143,8 @@
       !! ** Action  : - p_fval: i-k-mean poleward flux of pva
       !!----------------------------------------------------------------------
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point
+!FTRANS pva :I :I :z
+!! DCSE_NEMO: work around deficiency in ftrans
+!     REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point
+      REAL(wp) , INTENT(in)    ::   pva(jpi,jpj,jpk)           ! mask flux array at V-point
       !!
       INTEGER                  ::   ji, jj, jk   ! dummy loop arguments
@@ -149,7 +157,13 @@
       ijpj = jpj
       p_fval(:) = 0._wp
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! Vector opt.
+#endif
                p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 
             END DO
@@ -162,4 +176,9 @@
    END FUNCTION ptr_vj_3d
 
+!FTRANS CLEAR
+   !! * Re-instate directives to control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
 
    FUNCTION ptr_vj_2d( pva )   RESULT ( p_fval )
@@ -215,5 +234,8 @@
       !!
       IMPLICIT none
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point
+!FTRANS pva :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point
+      REAL(wp) , INTENT(in)             ::   pva(jpi,jpj,jpk)             ! mask flux array at V-point
       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask
       !!
@@ -236,4 +258,5 @@
 
       p_fval(:,:) = 0._wp
+
       !
       IF( PRESENT( pmsk ) ) THEN 
@@ -270,4 +293,9 @@
    END FUNCTION ptr_vjk
 
+!FTRANS CLEAR
+   !! * Re-instate directives to control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
 
    FUNCTION ptr_tjk( pta, pmsk )   RESULT ( p_fval )
@@ -286,5 +314,8 @@
 #endif
       !!
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point
+!FTRANS pta :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point
+      REAL(wp) , INTENT(in)             :: pta(jpi,jpj,jpk)     ! tracer flux array at T-point
       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask
       !!
@@ -307,7 +338,13 @@
 
       p_fval(:,:) = 0._wp
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji =  nldi, nlei
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
             DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
+#endif
                p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj)
             END DO
@@ -328,4 +365,9 @@
    END FUNCTION ptr_tjk
 
+!FTRANS CLEAR
+   !! * Re-instate directives to control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
 
    SUBROUTINE dia_ptr( kt )
@@ -334,5 +376,8 @@
       !!----------------------------------------------------------------------
       USE oce,     vt  =>   ua   ! use ua as workspace
-      USE oce,     vs  =>   ua   ! use ua as workspace
+!! DCSE_NEMO: see ticket 873
+      USE oce,     vs  =>   va   ! use va as workspace
+!! DCSE_NEMO: ua, va are re-named, so need additional directives
+!FTRANS vt vs :I :I :z
       IMPLICIT none
       !!
@@ -370,4 +415,5 @@
             !                                ! local heat & salt transports at T-points  ( tn*mj[vn+v_eiv] )
             vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp
+
             DO jk= 1, jpkm1
                DO jj = 2, jpj
@@ -434,4 +480,9 @@
    END SUBROUTINE dia_ptr
 
+!FTRANS CLEAR
+   !! * Re-instate directives to control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
 
    SUBROUTINE dia_ptr_init
@@ -489,5 +540,9 @@
          btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin
          WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean
+#if defined key_z_first
+         ELSE WHERE                     ;   btm30(:,:) = tmask_1(:,:)
+#else
          ELSE WHERE                     ;   btm30(:,:) = tmask(:,:,1)
+#endif
          END WHERE
       ENDIF
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 3211)
@@ -49,4 +49,6 @@
    USE dtasal
    USE lib_mpp         ! MPP library
+   USE zpermute, ONLY : permute_z_last   ! Re-order a 3d array back to external (z-last) ordering 
+   USE prtctl
 
    IMPLICIT NONE
@@ -65,4 +67,15 @@
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+#  include "dtatem_ftrans.h90"
+#  include "dtasal_ftrans.h90"
+
    !! * Substitutions
 #  include "zdfddm_substitute.h90"
@@ -96,4 +109,6 @@
    !!   'key_dimgout'                                      DIMG output file
    !!----------------------------------------------------------------------
+!! DCSE_NEMO: As at November 2011, the version of dia_wri() included here
+!! has not been modified or tested for z_first ordering. It will need attention.
 #   include "diawri_dimg.h90"
 
@@ -117,4 +132,6 @@
       !!----------------------------------------------------------------------
       USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace
+!! DCSE_NEMO: ta renamed, so need an additional directive
+!FTRANS z3d :I :I :z
       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY: z2d => wrk_2d_1
@@ -175,7 +192,13 @@
          zztmp = 0.5 * rcp
          z2d(:,:) = 0.e0 
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) )
                END DO
@@ -189,7 +212,13 @@
          CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction
          z2d(:,:) = 0.e0 
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) )
                END DO
@@ -416,7 +445,16 @@
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
 #endif
+
          clmx ="l_max(only(x))"    ! max index on a period
+!! DCSE_NEMO: Warning! (November 2011)
+!!            The results for sobowlin do not match between level-first and level-last
+!!            ordering when the variable is defined using the operator "l_max(only(x))"
+!!            but they do match when clop is used instead. There may be a bug deep inside
+!!            the hist routines.
+!!            This is a temporary change for testing purposes only.
+!        CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX 
+!           &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
          CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX 
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
 #if defined key_diahth
          CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth
@@ -516,6 +554,12 @@
 
       ! Write fields on T grid
+#if defined key_z_first
+      !! Need to transform 3d arrays back to external (z_last) ordering for dumping history
+      CALL histwrite( nid_T, "votemper", it, permute_z_last(tn), ndim_T , ndex_T  )   ! temperature
+      CALL histwrite( nid_T, "vosaline", it, permute_z_last(sn), ndim_T , ndex_T  )   ! salinity
+#else
       CALL histwrite( nid_T, "votemper", it, tn            , ndim_T , ndex_T  )   ! temperature
       CALL histwrite( nid_T, "vosaline", it, sn            , ndim_T , ndex_T  )   ! salinity
+#endif
       CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface temperature
       CALL histwrite( nid_T, "sosaline", it, sn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface salinity
@@ -528,5 +572,9 @@
 !!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff
       CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf )  , ndim_hT, ndex_hT )   ! c/d water flux
+#if defined key_z_first
+      zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * sn(:,:,1) * tmask_1(:,:)
+#else
       zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * sn(:,:,1) * tmask(:,:,1)
+#endif
       CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux
       CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
@@ -537,16 +585,44 @@
       CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
 #if ! defined key_coupled
-      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
-      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+      !! DCSE_NEMO: Warning! In testing, found that qrp and erp are sometimes written
+      !!            without being allocated. There should be a better way of fixing this.
+      IF (ALLOCATED(qrp)) THEN
+         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
+!     ELSE
+!        CALL ctl_warn('dia_wri: WARNING - qrp not allocated.')
+      ENDIF
+      IF (ALLOCATED(erp)) THEN
+         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+!     ELSE
+!        CALL ctl_warn('dia_wri: WARNING - erp not allocated.')
+      ENDIF
       IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)
       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
 #endif
 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) 
-      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
-      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+      !! DCSE_NEMO: Warning! In testing, found that qrp and erp are sometimes written
+      !!            without being allocated. There should be a better way of fixing this.
+      IF (ALLOCATED(qrp)) THEN
+         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
+!     ELSE
+!        CALL ctl_warn('dia_wri: WARNING - qrp not allocated.')
+      ENDIF
+      IF (ALLOCATED(erp)) THEN
+         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+!     ELSE
+!        CALL ctl_warn('dia_wri: WARNING - erp not allocated.')
+      ENDIF
+#if defined key_z_first
+         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask_1(:,:)
+#else
          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)
+#endif
       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
 #endif
       zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
+
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' dw/nmln : ', tab2d_2=tmask_1, clinfo2=' dw/tm_1 : ', ovlap=1 )
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=zw2d, clinfo1=' dw/zw2d : ', ovlap=1 )
+
       CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ???
 
@@ -569,18 +645,43 @@
 #endif
          ! Write fields on U grid
+#if defined key_z_first
+      CALL histwrite( nid_U, "vozocrtx", it, permute_z_last(un), ndim_U , ndex_U )    ! i-current
+#if defined key_diaeiv
+      CALL histwrite( nid_U, "vozoeivu", it, permute_z_last(u_eiv), ndim_U , ndex_U )    ! i-eiv current
+#endif
+#else
       CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
 #if defined key_diaeiv
       CALL histwrite( nid_U, "vozoeivu", it, u_eiv         , ndim_U , ndex_U )    ! i-eiv current
 #endif
+#endif
       CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
 
          ! Write fields on V grid
+#if defined key_z_first
+      CALL histwrite( nid_V, "vomecrty", it, permute_z_last(vn), ndim_V , ndex_V  )   ! j-current
+#if defined key_diaeiv
+      CALL histwrite( nid_V, "vomeeivv", it, permute_z_last(v_eiv), ndim_V , ndex_V  )   ! j-eiv current
+#endif
+#else
       CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
 #if defined key_diaeiv
       CALL histwrite( nid_V, "vomeeivv", it, v_eiv         , ndim_V , ndex_V  )   ! j-eiv current
 #endif
+#endif
       CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
 
          ! Write fields on W grid
+#if defined key_z_first
+      CALL histwrite( nid_W, "vovecrtz", it, permute_z_last(wn), ndim_T, ndex_T )    ! vert. current
+#   if defined key_diaeiv
+      CALL histwrite( nid_W, "voveeivw", it, permute_z_last(w_eiv), ndim_T, ndex_T )    ! vert. eiv current
+#   endif
+      CALL histwrite( nid_W, "votkeavt", it, permute_z_last(avt), ndim_T, ndex_T )    ! T vert. eddy diff. coef.
+      CALL histwrite( nid_W, "votkeavm", it, permute_z_last(avmu), ndim_T, ndex_T )    ! T vert. eddy visc. coef.
+      IF( lk_zdfddm ) THEN
+         CALL histwrite( nid_W, "voddmavs", it, permute_z_last(fsavs(:,:,:)), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
+      ENDIF
+#else
       CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
 #   if defined key_diaeiv
@@ -592,4 +693,5 @@
          CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
       ENDIF
+#endif
 #if defined key_traldf_c2d
       CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef.
@@ -711,10 +813,19 @@
 
       ! Write all fields on T grid
-      CALL histwrite( id_i, "votemper", kt, tn      , jpi*jpj*jpk, idex )    ! now temperature
-      CALL histwrite( id_i, "vosaline", kt, sn      , jpi*jpj*jpk, idex )    ! now salinity
+#if defined key_z_first
+      CALL histwrite( id_i, "votemper", kt, permute_z_last(tn), jpi*jpj*jpk, idex )    ! now temperature
+      CALL histwrite( id_i, "vosaline", kt, permute_z_last(sn), jpi*jpj*jpk, idex )    ! now salinity
+      CALL histwrite( id_i, "sossheig", kt, sshn              , jpi*jpj    , idex )    ! sea surface height
+      CALL histwrite( id_i, "vozocrtx", kt, permute_z_last(un), jpi*jpj*jpk, idex )    ! now i-velocity
+      CALL histwrite( id_i, "vomecrty", kt, permute_z_last(vn), jpi*jpj*jpk, idex )    ! now j-velocity
+      CALL histwrite( id_i, "vovecrtz", kt, permute_z_last(wn), jpi*jpj*jpk, idex )    ! now k-velocity
+#else
+      CALL histwrite( id_i, "votemper", kt, tn       , jpi*jpj*jpk, idex )    ! now temperature
+      CALL histwrite( id_i, "vosaline", kt, sn       , jpi*jpj*jpk, idex )    ! now salinity
       CALL histwrite( id_i, "sossheig", kt, sshn     , jpi*jpj    , idex )    ! sea surface height
       CALL histwrite( id_i, "vozocrtx", kt, un       , jpi*jpj*jpk, idex )    ! now i-velocity
       CALL histwrite( id_i, "vomecrty", kt, vn       , jpi*jpj*jpk, idex )    ! now j-velocity
       CALL histwrite( id_i, "vovecrtz", kt, wn       , jpi*jpj*jpk, idex )    ! now k-velocity
+#endif
       CALL histwrite( id_i, "sowaflup", kt, (emp-rnf), jpi*jpj    , idex )    ! freshwater budget
       CALL histwrite( id_i, "sohefldo", kt, qsr + qns, jpi*jpj    , idex )    ! total heat flux
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 3211)
@@ -40,4 +40,9 @@
 
    REAL(wp), DIMENSION (jpncs+1)       ::   surf             ! closed sea surface
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 3211)
@@ -43,4 +43,7 @@
    INTEGER ::   nsecd, nsecd05, ndt, ndt05
 
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 3211)
@@ -83,5 +83,5 @@
    INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4)
    INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices
-   INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: j-dimensions of the local subdomain and its first and last indoor indices
    INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in
    INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions
@@ -94,7 +94,9 @@
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local  ==> global domain i-index
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local  ==> global domain j-index
-   INTEGER, PUBLIC,               DIMENSION(jpidta) ::   mi0, mi1   !: global ==> local  domain i-index    !!bug ==> other solution?
+   INTEGER, PUBLIC,               DIMENSION(jpidta) ::   mi0, mi1   !: global ==> local  domain i-index
+   !                                                  !!bug ==> other solution?
    !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain)
-   INTEGER, PUBLIC,               DIMENSION(jpjdta) ::   mj0, mj1   !: global ==> local  domain j-index     !!bug ==> other solution?
+   INTEGER, PUBLIC,               DIMENSION(jpjdta) ::   mj0, mj1   !: global ==> local  domain j-index
+   !                                                  !!bug ==> other solution?
    !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain)
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor
@@ -130,8 +132,12 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w          !: depth of T-points (sum of e3w) (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept , gdepw   !: analytical depth at T-W  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v   , e3f     !: analytical vertical scale factors at  V--F
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t   , e3u     !:                                       T--U  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw            !: analytical vertical scale factors at  VW--
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w   , e3uw    !:                                        W--UW  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   &
+             & e3v   , e3f     !: analytical vertical scale factors at  V--F
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   &
+             & e3t   , e3u     !:                                       T--U  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   &
+             & e3vw            !: analytical vertical scale factors at  VW--
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   &
+             & e3w   , e3uw    !:                                        W--UW  points (m)
 #if defined key_vvl
    LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .TRUE.    !: variable grid flag
@@ -142,9 +148,13 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_1, gdepw_1   !: analytical depth at T-W  points (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v_1  , e3f_1     !: analytical vertical scale factors at  V--F
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_1  , e3u_1     !:                                       T--U  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   &
+             & e3t_1  , e3u_1     !:                                       T--U  points (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw_1             !: analytical vertical scale factors at  VW--
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_1  , e3uw_1    !:                                       W--UW  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_b              !: before         -      -      -    -   T      points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_b  , e3v_b     !:   -            -      -      -    -   U--V   points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   &
+             & e3w_1  , e3uw_1    !:                                       W--UW  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   &
+             & e3t_b              !: before         -      -      -    -   T      points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   &
+             & e3u_b  , e3v_b     !:   -            -      -      -    -   U--V   points (m)
 #else
    LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag
@@ -160,19 +170,25 @@
    !! =-----------------====------
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   :: gdept_0, gdepw_0 !: reference depth of t- and w-points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   :: e3t_0  , e3w_0   !: reference vertical scale factors at T- and W-pts (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   :: &
+             & e3t_0  , e3w_0   !: reference vertical scale factors at T- and W-pts (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3tp   , e3wp    !: ocean bottom level thickness at T and W points
 
    !! s-coordinate and hybrid z-s-coordinate
    !! =----------------======---------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   gsigt, gsigw   !: model level depth coefficient at t-, w-levels (analytic)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   gsi3w          !: model level depth coefficient at w-level (sum of gsigw)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   esigt, esigw   !: vertical scale factor coef. at t-, w-levels
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &
+             & gsigt, gsigw   !: model level depth coefficient at t-, w-levels (analytic)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &
+             & gsi3w          !: model level depth coefficient at w-level (sum of gsigw)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &
+             & esigt, esigw   !: vertical scale factor coef. at t-, w-levels
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf    !: ocean depth at the vertical of  V--F
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu    !:                                 T--U  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &
+             & hbatt , hbatu    !:                                 T--U  points (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot   !: ocean surface and bottom topographies 
    !                                        !  (if deviating from coordinate surfaces in HYBRID)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff     !: interface depth between stretching at  V--F
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu     !: and quasi-uniform spacing              T--U  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &
+             & hift  , hifu     !: and quasi-uniform spacing              T--U  points (m)
 
    !!----------------------------------------------------------------------
@@ -181,10 +197,15 @@
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy       !: number of ocean level (=0, 1, ... , jpk-1)
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt         !: vertical index of the bottom last T- ocean level
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv   !: vertical index of the bottom last U- and W- ocean level
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &
+             & mbku, mbkv   !: vertical index of the bottom last U- and W- ocean level
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy        !: ocean depth (meters)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i      !: interior domain T-point mask
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bmask        !: land/ocean mask of barotropic stream function
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask   !: land/ocean masks
+   !                                                                                     !  at T-, U-, V- and F-pts
+#if defined key_z_first
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_1, umask_1, vmask_1, fmask_1   !: as above, at sea surface only 
+#endif
 
    REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
@@ -235,4 +256,7 @@
 #endif
 
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -257,5 +281,5 @@
    INTEGER FUNCTION dom_oce_alloc()
       !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(11) :: ierr
+      INTEGER, DIMENSION(12) :: ierr
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -307,4 +331,10 @@
       ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(11) )
 #endif
+
+#if defined key_z_first
+      ALLOCATE( tmask_1(jpi,jpj) ,   umask_1(jpi,jpj),     & 
+         &      vmask_1(jpi,jpj) ,   fmask_1(jpi,jpj), STAT=ierr(12) )
+#endif
+
       !
       dom_oce_alloc = MAXVAL(ierr)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce_ftrans.h90	(revision 3211)
@@ -0,0 +1,58 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  dom_oce_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   dom_oce.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+
+!! DCSE_NEMO_QUESTION: Warning! See DOM/domzgr_substitute.h90
+
+!FTRANS gdep3w :I :I :z
+!FTRANS gdept :I :I :z
+!FTRANS gdepw :I :I :z
+
+!FTRANS e3v :I :I :z
+!FTRANS e3f :I :I :z
+!FTRANS e3t :I :I :z
+!FTRANS e3u :I :I :z
+!FTRANS e3w :I :I :z
+!FTRANS e3vw :I :I :z
+!FTRANS e3uw :I :I :z
+
+!FTRANS gdep3w_1 :I :I :z
+!FTRANS gdept_1 :I :I :z
+!FTRANS gdepw_1 :I :I :z
+!FTRANS e3v_1 :I :I :z
+!FTRANS e3f_1 :I :I :z
+!FTRANS e3t_1 :I :I :z
+!FTRANS e3u_1 :I :I :z
+!FTRANS e3w_1 :I :I :z
+!FTRANS e3vw_1 :I :I :z
+!FTRANS e3uw_1 :I :I :z
+!FTRANS e3t_b :I :I :z
+!FTRANS e3u_b :I :I :z
+!FTRANS e3v_b :I :I :z
+
+!FTRANS tmask :I :I :z
+!FTRANS umask :I :I :z
+!FTRANS vmask :I :I :z
+!FTRANS fmask :I :I :z
+
+!! DCSE_NEMO_QUESTION: do we need to do anything about:
+!! npcoa, nicoa, njcoa
+!! See dom_oce_alloc() in dom_oce.F90
+
+
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 3211)
@@ -41,4 +41,10 @@
    PUBLIC   dom_init   ! called by opa.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -87,4 +93,8 @@
          umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point
          vmask(:,:,:) = tmask(:,:,:)
+#if defined key_z_first
+         umask_1(:,:) = umask(:,:,1)
+         vmask_1(:,:) = vmask(:,:,1)
+#endif
       END IF
       !
@@ -96,6 +106,11 @@
       END DO
       !                                        ! Inverse of the local depth
+#if defined key_z_first
+      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask_1(:,:) ) * umask_1(:,:)
+      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask_1(:,:) ) * vmask_1(:,:)
+#else
       hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
       hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
+#endif
 
                              CALL dom_stp      ! time step
@@ -283,8 +298,15 @@
       !
       IF(lk_mpp) THEN
+#if defined key_z_first
+         CALL mpp_minloc( e1t(:,:), tmask_1(:,:), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask_1(:,:), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask_1(:,:), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask_1(:,:), ze2max, iima2,ijma2 )
+#else
          CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
          CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
          CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
          CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
+#endif
       ELSE
          ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 3211)
@@ -20,4 +20,7 @@
 
    PUBLIC   dom_cfg    ! called by opa.F90
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 3211)
@@ -32,4 +32,7 @@
 
    PUBLIC   dom_hgr   ! called by domain.F90
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 3211)
@@ -42,4 +42,9 @@
    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  icoord ! Workspace for dom_msk_nsa()
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -165,7 +170,13 @@
       !
       tmask(:,:,:) = 0._wp
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp
             END DO  
@@ -226,4 +237,20 @@
       ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask)
       ! -------------------------------------------
+#ifdef key_z_first
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            DO jk = 1, jpk
+               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
+               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
+            END DO
+         END DO
+         DO ji = 1, jpim1         ! NO vector opt.
+            DO jk = 1, jpk
+               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
+                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1, jpk
          DO jj = 1, jpjm1
@@ -238,4 +265,5 @@
          END DO
       END DO
+#endif
       CALL lbc_lnk( umask, 'U', 1._wp )      ! Lateral boundary conditions
       CALL lbc_lnk( vmask, 'V', 1._wp )
@@ -390,4 +418,11 @@
       CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
 
+#if defined key_z_first
+      !! 2d masks defined at sea surface only sometimes help performance
+      tmask_1(:,:) = tmask(:,:,1)
+      umask_1(:,:) = umask(:,:,1)
+      vmask_1(:,:) = vmask(:,:,1)
+      fmask_1(:,:) = fmask(:,:,1)
+#endif
             
       IF( nprint == 1 .AND. lwp ) THEN      ! Control print
@@ -491,7 +526,13 @@
       ! convex corners
       
+#if defined key_z_first
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
+#endif
                zaa = tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
                   &+ tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 3211)
@@ -17,4 +17,7 @@
 
    PUBLIC   dom_ngb   ! routine called in iom.F90 module
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -49,8 +52,15 @@
       zmask(:,:) = 0._wp
       SELECT CASE( cdgrid )
+#if defined key_z_first
+      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask_1(nldi:nlei,nldj:nlej)
+      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask_1(nldi:nlei,nldj:nlej)
+      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask_1(nldi:nlei,nldj:nlej)
+      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask_1(nldi:nlei,nldj:nlej)
+#else
       CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1)
       CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,1)
       CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,1)
       CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,1)
+#endif
       END SELECT
 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90	(revision 3211)
@@ -21,4 +21,8 @@
 
    PUBLIC   dom_stp   ! routine called by inidom.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 3211)
@@ -32,4 +32,10 @@
    REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:)     ::   r2dt   ! vertical profile time-step, = 2 rdttra 
       !                                                              ! except at nit000 (=rdttra) if neuler=0
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
 
    !! * Substitutions
@@ -110,4 +116,12 @@
       END DO  
       !                                         ! Compute and mask the inverse of the local depth at T, U, V and F points
+#if defined key_z_first
+      ee_t(:,:) = 1. / ee_t(:,:) * tmask_1(:,:)
+      ee_u(:,:) = 1. / ee_u(:,:) * umask_1(:,:)
+      ee_v(:,:) = 1. / ee_v(:,:) * vmask_1(:,:)
+      DO jj = 1, jpjm1                               ! f-point case fmask cannot be used 
+         ee_f(:,jj) = 1. / ee_f(:,jj) * umask_1(:,jj) * umask_1(:,jj+1)
+      END DO
+#else
       ee_t(:,:) = 1. / ee_t(:,:) * tmask(:,:,1)
       ee_u(:,:) = 1. / ee_u(:,:) * umask(:,:,1)
@@ -116,4 +130,5 @@
          ee_f(:,jj) = 1. / ee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1)
       END DO
+#endif
       CALL lbc_lnk( ee_f, 'F', 1. )                  ! lateral boundary condition on ee_f
       !
@@ -172,7 +187,13 @@
                                                 ! initialise before scale factors at (u/v)-points
       ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points
+#if defined key_z_first
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
+#endif
                zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk)
                zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl_ftrans.h90	(revision 3211)
@@ -0,0 +1,24 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  domvvl_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   domvvl.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+
+!FTRANS mut :I :I :z
+!FTRANS muu :I :I :z
+!FTRANS muv :I :I :z
+!FTRANS muf :I :I :z
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 3211)
@@ -26,4 +26,7 @@
    PUBLIC dom_wri        ! routine called by inidom.F90
 
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -66,4 +69,9 @@
       USE wrk_nemo, ONLY:   zprt  => wrk_2d_1 , zprw  => wrk_2d_2    ! 2D workspace
       USE wrk_nemo, ONLY:   zdepu => wrk_3d_1 , zdepv => wrk_3d_2    ! 3D     -
+
+      !! DCSE_NEMO: wrk_3d_1, wrk_3d_2 are re-named, need additional directives
+!FTRANS zdepu :I :I :z
+!FTRANS zdepv :I :I :z
+
       !!
       INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file
@@ -129,14 +137,30 @@
       
       CALL dom_uniq( zprw, 'T' )
+#if defined key_z_first
+      zprt = tmask_1(:,:) * zprw                               !    ! unique point mask
+#else
       zprt = tmask(:,:,1) * zprw                               !    ! unique point mask
+#endif
       CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )  
       CALL dom_uniq( zprw, 'U' )
+#if defined key_z_first
+      zprt = umask_1(:,:) * zprw
+#else
       zprt = umask(:,:,1) * zprw
+#endif
       CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )  
       CALL dom_uniq( zprw, 'V' )
+#if defined key_z_first
+      zprt = vmask_1(:,:) * zprw
+#else
       zprt = vmask(:,:,1) * zprw
+#endif
       CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )  
       CALL dom_uniq( zprw, 'F' )
+#if defined key_z_first
+      zprt = fmask_1(:,:) * zprw
+#else
       zprt = fmask(:,:,1) * zprw
+#endif
       CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )  
 
@@ -165,5 +189,9 @@
       
       ! note that mbkt is set to 1 over land ==> use surface tmask
+#if defined key_z_first
+      zprt(:,:) = tmask_1(:,:) * REAL( mbkt(:,:) , wp )
+#else
       zprt(:,:) = tmask(:,:,1) * REAL( mbkt(:,:) , wp )
+#endif
       CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
             
@@ -209,7 +237,13 @@
          IF( nmsh <= 3 ) THEN                                   !    ! 3D depth
             CALL iom_rstput( 0, 0, inum4, 'gdept', gdept, ktype = jp_r4 )     
-            DO jk = 1,jpk   
+#if defined key_z_first
+            DO jj = 1, jpjm1   
+               DO ji = 1, jpim1         ! NO vector opt.
+                  DO jk = 1, jpk   
+#else
+            DO jk = 1, jpk   
                DO jj = 1, jpjm1   
                   DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                      zdepu(ji,jj,jk) = MIN( gdept(ji,jj,jk) , gdept(ji+1,jj  ,jk) )
                      zdepv(ji,jj,jk) = MIN( gdept(ji,jj,jk) , gdept(ji  ,jj+1,jk) )
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 3211)
@@ -55,4 +55,8 @@
    REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for s-sigma coordinates
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+
   !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -78,5 +82,5 @@
       !!                   ln_zco=T   z-coordinate   
       !!                   ln_zps=T   z-coordinate with partial steps
-      !!                   ln_zco=T   s-coordinate 
+      !!                   ln_sco=T   s-coordinate 
       !!
       !! ** Action  :   define gdep., e3., mbathy and bathy
@@ -758,7 +762,27 @@
       !! ** Method  :   set 3D coord. arrays to reference 1D array 
       !!----------------------------------------------------------------------
+#if defined key_z_first
+      INTEGER  ::   ji, jj   ! Dummy loop indices
+#else
       INTEGER  ::   jk
-      !!----------------------------------------------------------------------
-      !
+#endif
+      !!----------------------------------------------------------------------
+      !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            fsdept(ji,jj,:) = gdept_0(:)
+            fsdepw(ji,jj,:) = gdepw_0(:)
+            fsde3w(ji,jj,:) = gdepw_0(:)
+            fse3t (ji,jj,:) = e3t_0(:)
+            fse3u (ji,jj,:) = e3t_0(:)
+            fse3v (ji,jj,:) = e3t_0(:)
+            fse3f (ji,jj,:) = e3t_0(:)
+            fse3w (ji,jj,:) = e3w_0(:)
+            fse3uw(ji,jj,:) = e3w_0(:)
+            fse3vw(ji,jj,:) = e3w_0(:)
+         END DO
+      END DO
+#else
       DO jk = 1, jpk
          fsdept(:,:,jk) = gdept_0(jk)
@@ -773,4 +797,5 @@
          fse3vw(:,:,jk) = e3w_0(jk)
       END DO
+#endif
       !
    END SUBROUTINE zgr_zco
@@ -824,4 +849,6 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   zprt => wrk_3d_1
+      !! DCSE_NEMO: wrk_3d_1 renamed, need additional directive
+!FTRANS zprt :I :I :z
       !!
       INTEGER  ::   ji, jj, jk       ! dummy loop indices
@@ -871,4 +898,14 @@
 
       ! Scale factors and depth at T- and W-points
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi                     ! intitialization to the reference z-coordinate
+            gdept(ji,jj,:) = gdept_0(:)
+            gdepw(ji,jj,:) = gdepw_0(:)
+            e3t  (ji,jj,:) = e3t_0  (:)
+            e3w  (ji,jj,:) = e3w_0  (:)
+         END DO
+      END DO
+#else
       DO jk = 1, jpk                        ! intitialization to the reference z-coordinate
          gdept(:,:,jk) = gdept_0(jk)
@@ -877,4 +914,5 @@
          e3w  (:,:,jk) = e3w_0  (jk)
       END DO
+#endif
       ! 
       DO jj = 1, jpj
@@ -938,4 +976,14 @@
 
       ! Scale factors and depth at U-, V-, UW and VW-points
+#if defined key_z_first
+      DO jj = 1, jpj                        ! initialisation to z-scale factors
+         DO ji = 1, jpi
+            e3u (ji,jj,:) = e3t_0(:)
+            e3v (ji,jj,:) = e3t_0(:)
+            e3uw(ji,jj,:) = e3w_0(:)
+            e3vw(ji,jj,:) = e3w_0(:)
+         END IF
+      END DO
+#else
       DO jk = 1, jpk                        ! initialisation to z-scale factors
          e3u (:,:,jk) = e3t_0(jk)
@@ -944,7 +992,14 @@
          e3vw(:,:,jk) = e3w_0(jk)
       END DO
-      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+#endif
+#if defined key_z_first
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            DO jk = 1, jpk        ! Computed as the minimum of neighbouring scale factors
+#else
+      DO jk = 1,jpk               ! Computed as the minimum of neighbouring scale factors
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                e3u (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) )
                e3v (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) )
@@ -965,4 +1020,18 @@
       
       ! Scale factor at F-point
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi                     ! initialisation to z-scale factors
+            e3f(ji,jj,:) = e3t_0(:)
+         END DO
+      END DO
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1                   ! NO vector opt.
+            DO jk = 1, jpk                  ! Computed as the minimum of neighbooring V-scale factors
+               e3f(ji,jj,jk) = MIN( e3v(ji,jj,jk), e3v(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1, jpk                        ! initialisation to z-scale factors
          e3f(:,:,jk) = e3t_0(jk)
@@ -975,4 +1044,5 @@
          END DO
       END DO
+#endif
       CALL lbc_lnk( e3f, 'F', 1._wp )       ! Lateral boundary conditions
       !
@@ -1129,4 +1199,15 @@
       USE wrk_nemo, ONLY:   esigwu3 => wrk_3d_9
       USE wrk_nemo, ONLY:   esigwv3 => wrk_3d_10
+      !! DCSE_NEMO: wrk_nemo module variables renamed, need additional directives
+!FTRANS gsigw3 :I :I :z
+!FTRANS gsigt3 :I :I :z
+!FTRANS gsi3w3 :I :I :z
+!FTRANS esigt3 :I :I :z
+!FTRANS esigw3 :I :I :z
+!FTRANS esigtu3 :I :I :z
+!FTRANS esigtv3 :I :I :z
+!FTRANS esigtf3 :I :I :z
+!FTRANS esigwu3 :I :I :z
+!FTRANS esigwv3 :I :I :z
       !
       INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
@@ -1574,7 +1655,13 @@
 
 !!gm bug?  no more necessary?  if ! defined key_helsinki
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                IF( fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN
                   WRITE(ctmp1,*) 'zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 3211)
@@ -50,4 +50,13 @@
    PUBLIC   istate_init   ! routine called by step.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "dtatem_ftrans.h90"
+#  include "dtasal_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -67,5 +76,5 @@
       !!----------------------------------------------------------------------
       ! - ML - needed for initialization of e3t_b
-      INTEGER  ::  jk     ! dummy loop indice
+      INTEGER  ::  ji, jj, jk     ! dummy loop indices
 
       IF(lwp) WRITE(numout,*)
@@ -134,7 +143,11 @@
          ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here
          IF( lk_vvl ) THEN
+#if defined key_z_first
+            fse3t_b(:,:,:) = fse3t_n(:,:,:)
+#else
             DO jk = 1, jpk
                fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
             ENDDO
+#endif
          ENDIF
          ! 
@@ -169,7 +182,13 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
       !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                tn(ji,jj,jk) = (  ( ( 7.5 - 0.*ABS(gphit(ji,jj))/30. )   &
                   &               *( 1.-TANH((fsdept(ji,jj,jk)-80.)/30.) )   &
@@ -253,8 +272,19 @@
             zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 )
             !
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  DO jk = 1, jpk
+                     tn(ji,jj,jk) = ( zt2 + zt1 * exp( - fsdept(ji,jj,jk) / 1000 ) ) * tmask(ji,jj,jk)
+                     tb(ji,jj,jk) = tn(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+#else
             DO jk = 1, jpk
                tn(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
                tb(:,:,jk) = tn(:,:,jk)
             END DO
+#endif
             !
             IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
@@ -294,5 +324,9 @@
             DO jj = 1, nlcj
                DO ji = 1, nlci
+#if defined key_z_first
+                  sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask_1(ji,jj)
+#else
                   sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask(ji,jj,1)
+#endif
                END DO
             END DO
@@ -374,7 +408,13 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
 
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+#else
          DO jk = 1, jpk
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   tn(ji,jj,jk) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   &
                        &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               &
@@ -448,4 +488,6 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   zprn => wrk_3d_1    ! 3D workspace
+      !! DCSE_NEMO: wrk_3d_1 renamed, need additional directive
+!FTRANS zprn :I :I :z
 
       USE dynspg          ! surface pressure gradient             (dyn_spg routine)
@@ -473,14 +515,31 @@
       zprn(:,:,1) = zalfg * fse3w(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
 
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 2, jpkm1                                        ! Vertical integration from the surface
+               zprn(ji,jj,jk) = zprn(ji,jj,jk-1)   &
+                  &           + zalfg * fse3w(ji,jj,jk) * ( 2. + rhd(ji,jj,jk) + rhd(ji,jj,jk-1) )
+            END DO  
+         END DO  
+      END DO  
+#else
       DO jk = 2, jpkm1                                              ! Vertical integration from the surface
          zprn(:,:,jk) = zprn(:,:,jk-1)   &
             &         + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
       END DO  
+#endif
 
       ! Compute geostrophic balance
       ! ---------------------------
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vertor opt.
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   &
                                + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  )
@@ -511,8 +570,19 @@
       ! to have a zero bottom velocity
 
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               un(ji,jj,jk) = ( un(ji,jj,jk) - un(ji,jj,jpkm1) ) * umask(ji,jj,jk)
+               vn(ji,jj,jk) = ( vn(ji,jj,jk) - vn(ji,jj,jpkm1) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1, jpkm1
          un(:,:,jk) = ( un(:,:,jk) - un(:,:,jpkm1) ) * umask(:,:,jk)
          vn(:,:,jk) = ( vn(:,:,jk) - vn(:,:,jpkm1) ) * vmask(:,:,jk)
       END DO
+#endif
 
       CALL lbc_lnk( un, 'U', -1. )
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90	(revision 3211)
@@ -32,4 +32,9 @@
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal   ! structure of input SST (file informations, fields read)
+
+   !! * Control permutation of array indices
+#  include "dtasal_ftrans.h90"
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
@@ -158,8 +163,19 @@
 #endif   
         
-      s_dta(:,:,:)=sf_sal(1)%fnow(:,:,:)
+#if defined key_z_first
+      !! DCSE_NEMO: Beware! These arrays will not be conformable after permuting indices of t_dta
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               s_dta(ji,jj,jk) = sf_sal(1)%fnow(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
+      s_dta(:,:,:) = sf_sal(1)%fnow(:,:,:)
+#endif
         
       IF( ln_sco ) THEN
-         DO jj = 1, jpj                  ! interpolation of salinites
+         DO jj = 1, jpj                  ! interpolation of salinities
             DO ji = 1, jpi
                DO jk = 1, jpk
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal_ftrans.h90	(revision 3211)
@@ -0,0 +1,21 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  dtasal_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   dtasal.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS s_dta :I :I :z
+
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90	(revision 3211)
@@ -32,4 +32,9 @@
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read)
+
+   !! * Control permutation of array indices
+#  include "dtatem_ftrans.h90"
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
@@ -171,5 +176,17 @@
 #endif
          
+#if defined key_z_first
+      !! DCSE_NEMO: Beware! These arrays will not be conformable after permuting indices of t_dta
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               t_dta(ji,jj,jk) = sf_tem(1)%fnow(ji,jj,jk) 
+            END DO
+         END DO
+      END DO
+#else
       t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 
+#endif
+
          
       IF( ln_sco ) THEN
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem_ftrans.h90	(revision 3211)
@@ -0,0 +1,21 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  dtatem_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   dtatem.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS t_dta :I :I :z
+
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 3211)
@@ -37,4 +37,9 @@
 
    PUBLIC   div_cur    ! routine called by step.F90 and istate.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -285,4 +290,52 @@
       ENDIF
 
+#if defined key_z_first
+      !                                             ! --------
+      ! Horizontal divergence                       !   div 
+      !                                             ! --------
+      hdivb(:,:,1:jpkm1) = hdivn(:,:,1:jpkm1)    ! time swap of div arrays
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+               hdivn(ji,jj,jk) =   &
+                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)       &
+                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)  )    &
+                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO  
+         END DO  
+      END DO
+
+#if defined key_obc
+      IF( Agrif_Root() ) THEN
+         ! open boundaries (div must be zero behind the open boundary)
+         !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column
+         IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,1:jpkm1) = 0.e0      ! east
+         IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,1:jpkm1) = 0.e0      ! west
+         IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,1:jpkm1) = 0.e0      ! north
+         IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,1:jpkm1) = 0.e0      ! south
+      ENDIF
+#endif         
+      IF( .NOT. AGRIF_Root() ) THEN
+         IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,1:jpkm1) = 0.e0      ! east
+         IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,1:jpkm1) = 0.e0      ! west
+         IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,1:jpkm1) = 0.e0      ! north
+         IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,1:jpkm1) = 0.e0      ! south
+      ENDIF
+
+         !                                             ! --------
+         ! relative vorticity                          !   rot 
+         !                                             ! --------
+      rotb (:,:,1:jpkm1) = rotn (:,:,1:jpkm1)    ! time swap of rot arrays
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            DO jk = 1, jpkm1
+               rotn(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                  &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                  &           * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) )
+            END DO
+         END DO
+      END DO
+#else
+
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
@@ -334,4 +387,5 @@
       END DO                                           !   End of slab
       !                                                ! ===============
+#endif
 
       IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 3211)
@@ -31,4 +31,7 @@
    
    INTEGER ::   nadv   ! choice of the formulation and scheme for the advection
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 3211)
@@ -26,4 +26,8 @@
    PUBLIC   dyn_adv_cen2   ! routine called by step.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -52,4 +56,14 @@
       USE wrk_nemo, ONLY:   zfu_f => wrk_3d_2 , zfv_f => wrk_3d_5 , zfv_vw =>wrk_3d_7
       USE wrk_nemo, ONLY:   zfw   => wrk_3d_3 
+      !! DCSE_NEMO: module variables renamed, need additional directives
+!FTRANS zfu :I :I :z
+!FTRANS zfv :I :I :z
+!FTRANS zfu_t :I :I :z
+!FTRANS zfv_t :I :I :z
+!FTRANS zfu_uw :I :I :z
+!FTRANS zfu_f :I :I :z
+!FTRANS zfv_f :I :I :z
+!FTRANS zfv_vw :I :I :z
+!FTRANS zfw :I :I :z
       !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 3211)
@@ -30,4 +30,8 @@
 
    PUBLIC   dyn_adv_ubs   ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
@@ -75,4 +79,18 @@
       USE wrk_nemo, ONLY:   zlu_uu => wrk_4d_1 , zlv_vv=>wrk_4d_3   ! 4D workspace
       USE wrk_nemo, ONLY:   zlu_uv => wrk_4d_2 , zlv_vu=>wrk_4d_4
+      !! DCSE_NEMO: module variables renamed, need additional directives
+!FTRANS zfu :I :I :z
+!FTRANS zfv :I :I :z
+!FTRANS zfu_t :I :I :z
+!FTRANS zfv_t :I :I :z
+!FTRANS zfu_uw :I :I :z
+!FTRANS zfu_f :I :I :z
+!FTRANS zfv_f :I :I :z
+!FTRANS zfv_vw :I :I :z
+!FTRANS zfw :I :I :z
+!FTRANS zlu_uu :I :I :z :I
+!FTRANS zlv_vv :I :I :z :I
+!FTRANS zlu_uv :I :I :z :I
+!FTRANS zlv_vu :I :I :z :I
       !
       INTEGER, INTENT(in) ::   kt     ! ocean time-step index
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 3211)
@@ -23,4 +23,9 @@
    PUBLIC   dyn_bfr    !  routine called by step.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -43,4 +48,7 @@
       !!---------------------------------------------------------------------
       USE oce, ONLY:   ztrduv => tsa   ! tsa used as 4D workspace
+      !! DCSE_NEMO: module variable renamed, need additional directives
+!FTRANS ztrduv :I :I :z :I
+
       !!
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 3211)
@@ -57,4 +57,8 @@
    INTEGER  ::   nhpg  =  0   ! = 0 to 6, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags)
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -79,4 +83,8 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2   ! 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ztrdu :I :I :z
+!FTRANS ztrdv :I :I :z
+
       !!
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
@@ -194,4 +202,8 @@
       !!----------------------------------------------------------------------
       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zhpi :I :I :z
+!FTRANS zhpj :I :I :z
+
       !!
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
@@ -223,7 +235,13 @@
       !
       ! interior value (2=<jk=<jpkm1)
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zcoef1 = zcoef0 * fse3w(ji,jj,jk)
                ! hydrostatic pressure gradient
@@ -254,4 +272,7 @@
       !!---------------------------------------------------------------------- 
       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zhpi :I :I :z
+!FTRANS zhpj :I :I :z
       !!
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
@@ -285,7 +306,13 @@
 
       ! interior value (2=<jk=<jpkm1)
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zcoef1 = zcoef0 * fse3w(ji,jj,jk)
                ! hydrostatic pressure gradient
@@ -355,4 +382,7 @@
       !!----------------------------------------------------------------------
       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zhpi :I :I :z
+!FTRANS zhpj :I :I :z
       !!
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
@@ -395,7 +425,13 @@
             
       ! interior value (2=<jk=<jpkm1)
+#if defined key_z_first
+      DO jj = 2, jpjm1     
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1                                  
+#else
       DO jk = 2, jpkm1                                  
          DO jj = 2, jpjm1     
             DO ji = fs_2, fs_jpim1   ! vector opt.      
+#endif
                ! hydrostatic pressure gradient along s-surfaces
                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
@@ -440,4 +476,7 @@
       !!----------------------------------------------------------------------
       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zhpi :I :I :z
+!FTRANS zhpj :I :I :z
       !!
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
@@ -476,7 +515,13 @@
       !
       ! interior value (2=<jk=<jpkm1)
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                ! hydrostatic pressure gradient along s-surfaces
                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) &
@@ -516,4 +561,7 @@
       !!----------------------------------------------------------------------
       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zhpi :I :I :z
+!FTRANS zhpj :I :I :z
       !!
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
@@ -555,7 +603,13 @@
 
       ! Interior value (2=<jk=<jpkm1) (weighted with zalph & zbeta)
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)                            &
                   &           * (   (            fsde3w(ji+1,jj,jk  ) + fsde3w(ji,jj,jk  )        &
@@ -603,4 +657,22 @@
       USE wrk_nemo, ONLY:   drhow => wrk_3d_13 , dzw  => wrk_3d_14
       USE wrk_nemo, ONLY:   rho_k => wrk_3d_15
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zhpi :I :I :z
+!FTRANS zhpj :I :I :z
+!FTRANS drhox :I :I :z
+!FTRANS dzx :I :I :z
+!FTRANS drhou :I :I :z
+!FTRANS dzu :I :I :z
+!FTRANS rho_i :I :I :z
+!FTRANS drhoy :I :I :z
+!FTRANS dzy :I :I :z
+!FTRANS drhov :I :I :z
+!FTRANS dzv :I :I :z
+!FTRANS rho_j :I :I :z
+!FTRANS drhoz :I :I :z
+!FTRANS dzz :I :I :z
+!FTRANS drhow :I :I :z
+!FTRANS dzw :I :I :z
+!FTRANS rho_k :I :I :z
       !!
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
@@ -633,7 +705,13 @@
 !!bug gm   Not a true bug, but... dzz=e3w  for dzx, dzy verify what it is really
 
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                drhoz(ji,jj,jk) = rhd   (ji  ,jj  ,jk) - rhd   (ji,jj,jk-1)
                dzz  (ji,jj,jk) = fsde3w(ji  ,jj  ,jk) - fsde3w(ji,jj,jk-1)
@@ -654,7 +732,13 @@
 !!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj
 
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1)
 
@@ -739,7 +823,13 @@
 !!bug gm    : optimisation: 1/10 and 1/12 the division should be done before the loop
 
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
 
                rho_k(ji,jj,jk) = zcoef0 * ( rhd   (ji,jj,jk) + rhd   (ji,jj,jk-1) )                                   &
@@ -794,7 +884,13 @@
       !  interior value   (2=<jk=<jpkm1)
       ! ----------------
+#if defined key_z_first
+      DO jj = 2, jpjm1 
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                ! hydrostatic pressure gradient along s-surfaces
                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                &
@@ -832,4 +928,15 @@
       USE wrk_nemo, ONLY:   zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6
       USE wrk_nemo, ONLY:   zhpjtra => wrk_3d_7 , zhpjne  => wrk_3d_8
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zhpi :I :I :z
+!FTRANS zhpj :I :I :z
+!FTRANS zhpiorg :I :I :z
+!FTRANS zhpirot :I :I :z
+!FTRANS zhpitra :I :I :z
+!FTRANS zhpine :I :I :z
+!FTRANS zhpjorg :I :I :z
+!FTRANS zhpjrot :I :I :z
+!FTRANS zhpjtra :I :I :z
+!FTRANS zhpjne :I :I :z
       !!
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
@@ -891,6 +998,11 @@
       DO jj = 1, jpjm1
          DO ji = 1, fs_jpim1   ! vector opt.
+#if defined key_z_first
+            zmskd1 = tmask_1(ji+1,jj+1) * tmask_1(ji  ,jj)      ! mask in the 1st diagnonal
+            zmskd2 = tmask_1(ji  ,jj+1) * tmask_1(ji+1,jj)      ! mask in the 2nd diagnonal
+#else
             zmskd1 = tmask(ji+1,jj+1,1) * tmask(ji  ,jj,1)      ! mask in the 1st diagnonal
             zmskd2 = tmask(ji  ,jj+1,1) * tmask(ji+1,jj,1)      ! mask in the 2nd diagnonal
+#endif
             ! hydrostatic pressure gradient along s-surfaces
             zhpitra(ji,jj,1) = zdistr(ji,jj) * zmskd1 * (  fse3t(ji+1,jj+1,1) * rhd(ji+1,jj+1,1)   &
@@ -927,7 +1039,13 @@
       ! -----------------
       ! compute and add to the general trend the pressure gradients along the axes
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                ! hydrostatic pressure gradient along s-surfaces
                zhpiorg(ji,jj,jk) = zhpiorg(ji,jj,jk-1)                                                 &
@@ -954,7 +1072,13 @@
 
       ! compute the pressure gradients in the diagonal directions
+#if defined key_z_first
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                zmskd1  = tmask(ji+1,jj+1,jk  ) * tmask(ji  ,jj,jk  )      ! level jk   mask in the 1st diagnonal
                zmskd1m = tmask(ji+1,jj+1,jk-1) * tmask(ji  ,jj,jk-1)      ! level jk-1    "               "     
@@ -987,7 +1111,13 @@
 
       ! interpolate and add to the general trend
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                ! averaging
                zhpirot(ji,jj,jk) = 0.5 * ( zhpine(ji,jj,jk) + zhpine(ji  ,jj-1,jk) )
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 3211)
@@ -24,4 +24,8 @@
 
    PUBLIC   dyn_keg    ! routine called by step module
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
    
    !! * Substitutions
@@ -55,4 +59,7 @@
       USE oce     , ONLY:   ztrdu => ta       , ztrdv => sa   ! (ta,sa) used as 3D workspace   
       USE wrk_nemo, ONLY:   zhke  => wrk_3d_1                 ! 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ztrdu ztrdv zhke :I :I :z
+
       !!
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
@@ -77,4 +84,24 @@
       ENDIF
       
+#if defined key_z_first
+      DO jj = 2, jpj            ! Horizontal kinetic energy at T-point
+         DO ji = 2, jpi
+            DO jk = 1, jpkm1
+               zhke(ji,jj,jk) = 0.25 * (   un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
+                  &                      + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   &
+                                         + vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
+                  &                      + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   )
+            END DO  
+         END DO  
+      END DO
+      DO jj = 2, jpjm1          ! add the gradient of kinetic energy to the general momentum trends
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
+               va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)
+            END DO 
+         END DO
+      END DO
+#else
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
@@ -126,4 +153,5 @@
       END DO                                           !   End of slab
       !                                                ! ===============
+#endif
 
       IF( l_trddyn ) THEN      ! save the Kinetic Energy trends for diagnostic
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 3211)
@@ -35,4 +35,10 @@
    INTEGER ::   nldf = -2   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -53,4 +59,8 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ztrdu :I :I :z
+!FTRANS ztrdv :I :I :z
+
       !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 3211)
@@ -28,4 +28,9 @@
 
    PUBLIC   dyn_ldf_bilap   ! called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
 
    !! * Substitutions
@@ -75,7 +80,12 @@
       !!----------------------------------------------------------------------
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY:   zcu => wrk_2d_1 , zcv => wrk_2d_2   ! 3D workspace
+      USE wrk_nemo, ONLY:   zcu => wrk_2d_1 , zcv => wrk_2d_2   ! 2D workspace
       USE wrk_nemo, ONLY:   zuf => wrk_3d_3 , zut => wrk_3d_4   ! 3D workspace
       USE wrk_nemo, ONLY:   zlu => wrk_3d_5 , zlv => wrk_3d_6
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zuf :I :I :z
+!FTRANS zut :I :I :z
+!FTRANS zlu :I :I :z
+!FTRANS zlv :I :I :z
       !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 3211)
@@ -35,4 +35,11 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zfuw, zfvw , zdiu, zdiv   ! 2D workspace (ldfguv)
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zdju, zdj1u, zdjv, zdj1v  ! 2D workspace (ldfguv)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
 
    !! * Substitutions
@@ -87,4 +94,9 @@
       USE wrk_nemo, ONLY:   zwk1 => wrk_3d_3 , zwk2 => wrk_3d_4   ! 3D workspace
       USE oce     , ONLY:   zwk3 => ta       , zwk4 => sa         ! ta, sa used as 3D workspace   
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwk1 :I :I :z
+!FTRANS zwk2 :I :I :z
+!FTRANS zwk3 :I :I :z
+!FTRANS zwk4 :I :I :z
       !
       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
@@ -120,7 +132,13 @@
       ! Update the momentum trends
       ! --------------------------
+#if defined key_z_first
+      DO jj = 2, jpjm1               ! add the diffusive trend to the general momentum trends
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jj = 2, jpjm1               ! add the diffusive trend to the general momentum trends
          DO jk = 1, jpkm1
             DO ji = 2, jpim1
+#endif
                ua(ji,jj,jk) = ua(ji,jj,jk) + zwk3(ji,jj,jk)
                va(ji,jj,jk) = va(ji,jj,jk) + zwk4(ji,jj,jk)
@@ -180,9 +198,16 @@
       USE wrk_nemo, ONLY:   zdkv => wrk_2d_7 , zdk1v => wrk_2d_8
       !!
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity 
+!FTRANS pu :I :I :z
+!FTRANS pv :I :I :z
+!FTRANS plu :I :I :z
+!FTRANS plv :I :I :z
+!! DCSE_NEMO: work around deficiency in ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity 
       !                                                               ! 2nd call: ahm x these fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   plu, plv   ! partial harmonic operator applied to
+      REAL(wp), INTENT(in   ) ::   pu(jpi,jpj,jpk) , pv(jpi,jpj,jpk)
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   plu, plv   ! partial harmonic operator applied to
       !                                                               ! pu and pv (all the components except
       !                                                               ! second order vertical derivative term)
+      REAL(wp), INTENT(  out) ::   plu(jpi,jpj,jpk), plv(jpi,jpj,jpk) ! partial harmonic operator applied to
       INTEGER                         , INTENT(in   ) ::   kahm       ! =1 1st call ; =2 2nd call
       !
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 3211)
@@ -38,4 +38,12 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zdiu, zdju, zdj1u   ! 2D workspace (dyn_ldf_iso) 
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfvw, zdiv, zdjv, zdj1v   !  -      -
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
 
    !! * Substitutions
@@ -134,7 +142,13 @@
       IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1       ! set the slopes of iso-level
+            DO ji = fs_2, fs_jpim1    
+               DO jk = 1, jpk       
+#else
          DO jk = 1, jpk         ! set the slopes of iso-level
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk)
                   vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 3211)
@@ -28,4 +28,11 @@
 
    PUBLIC dyn_ldf_lap  ! called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
 
    !! * Substitutions
@@ -73,4 +80,9 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
       ENDIF
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
@@ -78,4 +90,5 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                ze2u = rotb (ji,jj,jk) * fsahmf(ji,jj,jk) * fse3f(ji,jj,jk)
                ze1v = hdivb(ji,jj,jk) * fsahmt(ji,jj,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 3211)
@@ -49,4 +49,11 @@
    PUBLIC    dyn_nxt   ! routine called by step.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -95,4 +102,7 @@
       USE oce     , ONLY:   ze3u_f => ta       , ze3v_f => sa       ! (ta,sa) used as 3D workspace
       USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ze3u_f :I :I :z
+!FTRANS ze3v_f :I :I :z
       !
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
@@ -214,15 +224,32 @@
       ! ------------------------------------------
       IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  un(ji,jj,jk) = ua(ji,jj,jk)                ! un <-- ua
+                  vn(ji,jj,jk) = va(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             un(:,:,jk) = ua(:,:,jk)                          ! un <-- ua
             vn(:,:,jk) = va(:,:,jk)
          END DO
+#endif
       ELSE                                             !* Leap-Frog : Asselin filter and swap
          !                                ! =============!
          IF( .NOT. lk_vvl ) THEN          ! Fixed volume !
             !                             ! =============!
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO ji = 1, jpi    
+                  DO jk = 1, jpkm1                              
+#else
             DO jk = 1, jpkm1                              
                DO jj = 1, jpj
                   DO ji = 1, jpi    
+#endif
                      zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) )
                      zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) )
@@ -247,5 +274,9 @@
             ! Add volume filter correction only at the first level of t-point scale factors
             zec = atfp * rdt / rau0
+#if defined key_z_first
+            fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask_1(:,:)
+#else
             fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)
+#endif
             ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations
             zs_t  (:,:) =       e1t(:,:) * e2t(:,:)
@@ -257,7 +288,13 @@
                ! -----------------------------------
                ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points
+#if defined key_z_first
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpjm1
                      DO ji = 1, jpim1
+#endif
                         zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk)
                         zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk)
@@ -276,7 +313,13 @@
                ! Leap-Frog - Asselin filter and swap: applied on velocity
                ! -----------------------------------
+#if defined key_z_first
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpj
                      DO ji = 1, jpi
+#endif
                         zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) )
                         zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) )
@@ -294,7 +337,13 @@
                !-----------------------------------------------
                ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points
+#if defined key_z_first
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpjm1
                      DO ji = 1, jpim1
+#endif
                         zv_t_ij          = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk)
                         zv_t_ip1j        = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk)
@@ -313,7 +362,13 @@
                ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity
                ! -----------------------------------             ===========================
+#if defined key_z_first
+               DO jj = 1, jpj
+                  DO ji = 1, jpim1
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpj
                      DO ji = 1, jpim1
+#endif
                         zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk)
                         zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 3211)
@@ -38,4 +38,10 @@
    INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_... 
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -76,4 +82,8 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   ztrdu => wrk_3d_4 , ztrdv => wrk_3d_5    ! 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ztrdu :I :I :z
+!FTRANS ztrdv :I :I :z
+
       !
       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
@@ -108,7 +118,13 @@
             END DO
          END DO
+#if defined key_z_first
+         DO jj = 2, jpjm1                          ! Add the apg to the general trend
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1                          ! Add the apg to the general trend
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj)
                   va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 3211)
@@ -33,4 +33,10 @@
 
    PUBLIC   dyn_spg_exp   ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -89,7 +95,13 @@
             END DO 
          END DO 
+#if defined key_z_first
+         DO jj = 2, jpjm1                    ! Add it to the general trend
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1                    ! Add it to the general trend
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj)
                   va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 3211)
@@ -56,4 +56,12 @@
    PUBLIC   flt_rst      ! routine called by istate.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -104,4 +112,7 @@
       !!---------------------------------------------------------------------
       USE oce, ONLY:   zub   => ta , zvb   => sa   ! (ta,sa) used as workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zub :I :I :z
+!FTRANS zvb :I :I :z
       !!
       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
@@ -138,7 +149,13 @@
          !
          IF( ln_dynadv_vec ) THEN      ! vector form : applied on velocity
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      ua(ji,jj,jk) = (  ub(ji,jj,jk) + z2dt * ua(ji,jj,jk)  ) * umask(ji,jj,jk)
                      va(ji,jj,jk) = (  vb(ji,jj,jk) + z2dt * va(ji,jj,jk)  ) * vmask(ji,jj,jk)
@@ -148,7 +165,13 @@
             !
          ELSE                          ! flux form : applied on thickness weighted velocity
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      ua(ji,jj,jk) = (        ub(ji,jj,jk) * fse3u_b(ji,jj,jk)      &
                         &           + z2dt * ua(ji,jj,jk) * fse3u_n(ji,jj,jk)  )   &
@@ -171,7 +194,13 @@
             END DO 
          END DO 
+#if defined key_z_first
+         DO jj = 2, jpjm1              ! unweighted time stepping 
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1              ! unweighted time stepping 
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ua(ji,jj,jk) = (  ub(ji,jj,jk) + z2dt * ( ua(ji,jj,jk) + spgu(ji,jj) )  ) * umask(ji,jj,jk)
                   va(ji,jj,jk) = (  vb(ji,jj,jk) + z2dt * ( va(ji,jj,jk) + spgv(ji,jj) )  ) * vmask(ji,jj,jk)
@@ -214,7 +243,13 @@
          END DO
       ELSE                        ! No  vector opt.
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = 2, jpim1
+#endif
                   spgu(ji,jj) = spgu(ji,jj) + fse3u(ji,jj,jk) * ua(ji,jj,jk)
                   spgv(ji,jj) = spgv(ji,jj) + fse3v(ji,jj,jk) * va(ji,jj,jk)
@@ -333,7 +368,13 @@
       !                       trend, the leap-frog time stepping will not
       !                       be done in dynnxt.F90 routine)
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                ua(ji,jj,jk) = ( ua(ji,jj,jk) + spgu(ji,jj) ) * umask(ji,jj,jk)
                va(ji,jj,jk) = ( va(ji,jj,jk) + spgv(ji,jj) ) * vmask(ji,jj,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 3211)
@@ -57,4 +57,12 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b, vb_b   ! before averaged velocity
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -179,4 +187,9 @@
       zva(:,:) = 0.e0   ;   zvn(:,:) = 0.e0   ;   vb_b(:,:) = 0.e0
       !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
 #if defined key_vectopt_loop
@@ -186,4 +199,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
 #endif
                !                                                                              ! now trend
@@ -206,7 +220,13 @@
 
       !                                   !* baroclinic momentum trend (remove the vertical mean trend)
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1                    ! --------------------------
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                ua(ji,jj,jk) = ua(ji,jj,jk) - zua(ji,jj) * hur(ji,jj)
                va(ji,jj,jk) = va(ji,jj,jk) - zva(ji,jj) * hvr(ji,jj)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 3211)
@@ -52,4 +52,8 @@
    INTEGER ::   ntot = 4   ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -72,4 +76,8 @@
       !!----------------------------------------------------------------------
       USE oce, ONLY:   ztrdu => ta , ztrdv => sa   ! (ta,sa) used as 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ztrdu :I :I :z
+!FTRANS ztrdv :I :I :z
+
       !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
@@ -210,6 +218,11 @@
       INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ;
       !                                                           ! =nrvm (relative vorticity or metric)
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
+!FTRANS pua :I :I :z
+!FTRANS pva :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend
+!     REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
+      REAL(wp), INTENT(inout) ::   pua(jpi,jpj,jpk)    ! total u-trend
+      REAL(wp), INTENT(inout) ::   pva(jpi,jpj,jpk)    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -441,6 +454,11 @@
       INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ;
          !                                                        ! =nrvm (relative vorticity or metric)
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
+!FTRANS pua :I :I :z
+!FTRANS pva :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend
+!     REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
+      REAL(wp), INTENT(inout) ::   pua(jpi,jpj,jpk)    ! total u-trend
+      REAL(wp), INTENT(inout) ::   pva(jpi,jpj,jpk)    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk           ! dummy loop indices
@@ -552,4 +570,5 @@
       USE wrk_nemo, ONLY:   ztsw => wrk_2d_6 , ztse => wrk_2d_7
 #if defined key_vvl
+!FTRANS ze3f :I :I :z
       USE wrk_nemo, ONLY:   ze3f => wrk_3d_1                                           ! 3D workspace (lk_vvl=T)
 #endif
@@ -558,6 +577,11 @@
       INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ;
       !                                                           ! =nrvm (relative vorticity or metric)
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
+!FTRANS pua :I :I :z
+!FTRANS pva :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend
+!     REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
+      REAL(wp), INTENT(inout) ::   pua(jpi,jpj,jpk)    ! total u-trend
+      REAL(wp), INTENT(inout) ::   pva(jpi,jpj,jpk)   ! total v-trend
       !!
       INTEGER  ::   ji, jj, jk         ! dummy loop indices
@@ -565,4 +589,5 @@
       REAL(wp) ::   zfac12, zua, zva   ! local scalars
 #if ! defined key_vvl
+!FTRANS ze3f :I :I :z
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE ::   ze3f     ! lk_vvl=F, ze3f=1/e3f saved one for all
 #endif
@@ -599,5 +624,4 @@
       zfac12 = 1._wp / 12._wp    ! Local constant initialization
 
-      
 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse )
       !                                                ! ===============
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 3211)
@@ -26,4 +26,9 @@
    
    PUBLIC   dyn_zad   ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -57,4 +62,9 @@
       USE oce     , ONLY:   zwuw  => ta       , zwvw  => sa          ! (ta,sa) used as 3D workspace
       USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2    ! 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwuw  :I :I :z
+!FTRANS zwvw  :I :I :z
+!FTRANS ztrdu :I :I :z
+!FTRANS ztrdv :I :I :z
       !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
@@ -77,5 +87,27 @@
          ztrdv(:,:,:) = va(:,:,:) 
       ENDIF
-      
+
+#if defined key_z_first
+      !! DCSE_NEMO: Attention! Eliminate k-dependence from zww to re-order loops
+      DO jj = 2, jpj                   ! vertical fluxes 
+         DO ji = 2, jpi
+            zww(ji,jj) = 0.25 * e1t(ji,jj) * e2t(ji,jj)
+         END DO
+      END DO
+      DO jj = 2, jpjm1                 ! vertical momentum advection at w-point
+         DO ji = 2, jpim1
+            zwuw(ji,jj, 1 ) = 0.e0     ! Surface values set to zero
+            zwvw(ji,jj, 1 ) = 0.e0
+            DO jk = 2, jpkm1
+               zwuw(ji,jj,jk) =   ( zww(ji+1,jj  )*wn(ji+1,jj  ,jk) + zww(ji,jj)*wn(ji,jj,jk) )   &
+                  &             * ( un(ji,jj,jk-1)-un(ji,jj,jk) ) 
+               zwvw(ji,jj,jk) =   ( zww(ji  ,jj+1)*wn(ji  ,jj+1,jk) + zww(ji,jj)*wn(ji,jj,jk) )   &
+                  &             * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) )
+            END DO  
+            zwuw(ji,jj,jpk) = 0.e0     ! Bottom values set to zero
+            zwvw(ji,jj,jpk) = 0.e0
+         END DO   
+      END DO
+#else
       DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical
          DO jj = 2, jpj                   ! vertical fluxes 
@@ -99,8 +131,15 @@
          END DO  
       END DO
+#endif
 
+#if defined key_z_first
+      DO jj = 2, jpjm1              ! Vertical momentum advection at u- and v-points
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1       ! vector opt.
+#endif
                !                         ! vertical momentum advective trends
                zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 3211)
@@ -35,4 +35,10 @@
    REAL(wp) ::   r2dt       ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -55,4 +61,7 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2    ! 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ztrdu :I :I :z
+!FTRANS ztrdv :I :I :z
       !!
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
@@ -112,4 +121,5 @@
       USE zdfgls
       USE zdfkpp
+#  include "zdftke_ftrans.h90"
       !!----------------------------------------------------------------------
       !
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 3211)
@@ -27,4 +27,10 @@
 
    PUBLIC   dyn_zdf_exp   ! called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
    
    !! * Substitutions
@@ -57,4 +63,9 @@
       USE oce     , ONLY:   zwx => ta       , zwy => sa         ! (ta,sa) used as 3D workspace
       USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zww => wrk_3d_2   ! 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwx :I :I :z
+!FTRANS zwy :I :I :z
+!FTRANS zwz :I :I :z
+!FTRANS zww :I :I :z
       !
       INTEGER , INTENT(in) ::   kt     ! ocean time-step index
@@ -85,7 +96,13 @@
          END DO  
       END DO  
+#if defined key_z_first
+      DO jj = 2, jpjm1                 ! Initialization of x, z and contingently trends array
+         DO ji = 2, jpim1
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk                   ! Initialization of x, z and contingently trends array
          DO jj = 2, jpjm1 
             DO ji = 2, jpim1
+#endif
                zwx(ji,jj,jk) = ub(ji,jj,jk)
                zwz(ji,jj,jk) = vb(ji,jj,jk)
@@ -96,7 +113,13 @@
       DO jl = 1, nn_zdfexp             ! Time splitting loop
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1
+               DO jk = 2, jpk                ! First vertical derivative
+#else
          DO jk = 2, jpk                      ! First vertical derivative
             DO jj = 2, jpjm1 
                DO ji = 2, jpim1
+#endif
                   zwy(ji,jj,jk) = avmu(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) / fse3uw(ji,jj,jk) 
                   zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / fse3vw(ji,jj,jk)
@@ -104,7 +127,13 @@
             END DO  
          END DO  
+#if defined key_z_first
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1              ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp
+#else
          DO jk = 1, jpkm1                    ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp
             DO jj = 2, jpjm1 
                DO ji = 2, jpim1
+#endif
                   zua = zlavmr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) / fse3u(ji,jj,jk)
                   zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / fse3v(ji,jj,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 3211)
@@ -25,4 +25,10 @@
 
    PUBLIC   dyn_zdf_imp   ! called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
 
    !! * Substitutions
@@ -57,4 +63,8 @@
       USE oce     , ONLY:  zwd  => ta       , zws   => sa   ! (ta,sa) used as 3D workspace
       USE wrk_nemo, ONLY:   zwi => wrk_3d_3                 ! 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwd :I :I :z
+!FTRANS zws :I :I :z
+!FTRANS zwi :I :I :z
       !!
       INTEGER , INTENT(in) ::   kt    ! ocean time-step index
@@ -62,5 +72,5 @@
       !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars
+      REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs, zzwibd   ! local scalars
       !!----------------------------------------------------------------------
 
@@ -88,7 +98,8 @@
       ! is no need to include these in the implicit calculation.
       !
-      DO jk = 1, jpkm1        ! Matrix
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_z_first
+      DO jj = 2, jpjm1 
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
                zcoef = - p2dt / fse3u(ji,jj,jk)
                zzwi          = zcoef * avmu (ji,jj,jk  ) / fse3uw(ji,jj,jk  )
@@ -98,12 +109,29 @@
                zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
             END DO
-         END DO
-      END DO
-      DO jj = 2, jpjm1        ! Surface boudary conditions
-         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! Surface boundary conditions
             zwi(ji,jj,1) = 0._wp
             zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
          END DO
       END DO
+#else
+      DO jk = 1, jpkm1        ! Matrix
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcoef = - p2dt / fse3u(ji,jj,jk)
+               zzwi          = zcoef * avmu (ji,jj,jk  ) / fse3uw(ji,jj,jk  )
+               zwi(ji,jj,jk) = zzwi  * umask(ji,jj,jk)
+               zzws          = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1)
+               zws(ji,jj,jk) = zzws  * umask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
+            END DO
+         END DO
+      END DO
+      DO jj = 2, jpjm1        ! Surface boudary conditions
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END DO
+      END DO
+#endif
 
       ! Matrix inversion starting from the first level
@@ -122,16 +150,42 @@
       !-----------------------------------------------------------------------
       !
-      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-         DO jj = 2, jpjm1   
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
-         DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_z_first
+      DO jj = 2, jpjm1 
+         DO ji = 2, jpim1
+            !== Do first and second recurrences in the same loop
             ua(ji,jj,1) = ub(ji,jj,1) + p2dt * (  ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
                &                                                       / ( fse3u(ji,jj,1) * rau0       )  )
+            DO jk = 2, jpkm1
+               zzwibd = zwi(ji,jj,jk) / zwd(ji,jj,jk-1)
+               !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zzwibd * zws(ji,jj,jk-1)
+               !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
+               zrhs = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk)   ! zrhs=right hand side
+               ua(ji,jj,jk) = zrhs - zzwibd * ua(ji,jj,jk-1)
+            END DO
+            !==  third recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==
+            ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+            DO jk = jpk-2, 1, -1
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+            ! Normalization to obtain the general momentum trend ua
+            DO jk = 1, jpkm1
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt
+            END DO
+         END DO
+      END DO
+#else
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ua(ji,jj,1) = ub(ji,jj,1) + p2dt * (  ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
+               &                                                       / ( fse3u(ji,jj,1) * rau0       )  )
          END DO
       END DO
@@ -145,5 +199,5 @@
       END DO
       !
-      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==
+      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==
          DO ji = fs_2, fs_jpim1   ! vector opt.
             ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
@@ -157,5 +211,4 @@
          END DO
       END DO
-
       ! Normalization to obtain the general momentum trend ua
       DO jk = 1, jpkm1
@@ -166,5 +219,5 @@
          END DO
       END DO
-
+#endif
 
       ! 2. Vertical diffusion on v
@@ -177,7 +230,8 @@
       ! is no need to include these in the implicit calculation.
       !
-      DO jk = 1, jpkm1        ! Matrix
-         DO jj = 2, jpjm1   
-            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_z_first
+      DO jj = 2, jpjm1   
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1        ! Matrix
                zcoef = -p2dt / fse3v(ji,jj,jk)
                zzwi          = zcoef * avmv (ji,jj,jk  ) / fse3vw(ji,jj,jk  )
@@ -187,12 +241,29 @@
                zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
             END DO
-         END DO
-      END DO
-      DO jj = 2, jpjm1        ! Surface boudary conditions
-         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! Surface boundary conditions
             zwi(ji,jj,1) = 0._wp
             zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
          END DO
       END DO
+#else
+      DO jk = 1, jpkm1        ! Matrix
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcoef = -p2dt / fse3v(ji,jj,jk)
+               zzwi          = zcoef * avmv (ji,jj,jk  ) / fse3vw(ji,jj,jk  )
+               zwi(ji,jj,jk) =  zzwi * vmask(ji,jj,jk)
+               zzws          = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
+               zws(ji,jj,jk) =  zzws * vmask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
+            END DO
+         END DO
+      END DO
+      DO jj = 2, jpjm1        ! Surface boudary conditions
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END DO
+      END DO
+#endif
 
       ! Matrix inversion
@@ -211,16 +282,42 @@
       !-----------------------------------------------------------------------
       !
-      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-         DO jj = 2, jpjm1   
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
-         DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_z_first
+      DO jj = 2, jpjm1   
+         DO ji = 2, jpim1
+            !== Do first and second recurrences in the same loop
             va(ji,jj,1) = vb(ji,jj,1) + p2dt * (  va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
                &                                                       / ( fse3v(ji,jj,1) * rau0       )  )
+            DO jk = 2, jpkm1
+               zzwibd = zwi(ji,jj,jk) / zwd(ji,jj,jk-1)
+               !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zzwibd * zws(ji,jj,jk-1)
+               !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
+               zrhs = vb(ji,jj,jk) + p2dt * va(ji,jj,jk)   ! zrhs=right hand side
+               va(ji,jj,jk) = zrhs - zzwibd * va(ji,jj,jk-1)
+            END DO
+            !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==
+            va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+            DO jk = jpk-2, 1, -1
+               va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+            ! Normalization to obtain the general momentum trend va
+            DO jk = 1, jpkm1
+               va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt
+            END DO
+         END DO
+      END DO
+#else
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            va(ji,jj,1) = vb(ji,jj,1) + p2dt * (  va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
+               &                                                       / ( fse3v(ji,jj,1) * rau0       )  )
          END DO
       END DO
@@ -234,5 +331,5 @@
       END DO
       !
-      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==
+      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==
          DO ji = fs_2, fs_jpim1   ! vector opt.
             va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
@@ -255,4 +352,5 @@
          END DO
       END DO
+#endif
       !
       IF( wrk_not_released(3, 3) )   CALL ctl_stop('dyn_zdf_imp: failed to release workspace array')
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 3211)
@@ -46,4 +46,14 @@
    PUBLIC   ssh_nxt    ! called by step.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+#if defined key_asminc 
+#  include "asminc_ftrans.h90"
+#endif
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -78,4 +88,6 @@
       USE oce     , ONLY:   z3d   => ta                           ! ta used as 3D workspace
       USE wrk_nemo, ONLY:   zhdiv => wrk_2d_1 , z2d => wrk_2d_2   ! 2D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS z3d :I :I :z
       !
       INTEGER, INTENT(in) ::   kt   ! time step
@@ -100,7 +112,13 @@
             DO jj = 1, jpjm1
                DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible
+#if defined key_z_first
+                  zcoefu = 0.5  * umask_1(ji,jj) / ( e1u(ji,jj) * e2u(ji,jj) )
+                  zcoefv = 0.5  * vmask_1(ji,jj) / ( e1v(ji,jj) * e2v(ji,jj) )
+                  zcoeff = 0.25 * umask_1(ji,jj) * umask_1(ji,jj+1)
+#else
                   zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )
                   zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )
                   zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1)
+#endif
                   sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )
@@ -117,8 +135,15 @@
             DO jj = 1, jpjm1
                DO ji = 1, jpim1      ! NO Vector Opt.
+#if defined key_z_first
+                  sshf_n(ji,jj) = 0.5  * umask_1(ji,jj) * umask_1(ji,jj+1)                   &
+                       &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                       &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                       &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+#else
                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   &
                        &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
                        &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
                        &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+#endif
                END DO
             END DO
@@ -131,4 +156,17 @@
       IF( lk_vvl ) THEN                           !  Regridding: Update Now Vertical coord.  !   (only in vvl case)
          !                                        !------------------------------------------!
+#if defined key_z_first
+         fsdept(:,:,1:jpkm1) = fsdept_n(:,:,1:jpkm1)   ! now local depths stored in fsdep. arrays
+         fsdepw(:,:,1:jpkm1) = fsdepw_n(:,:,1:jpkm1)
+         fsde3w(:,:,1:jpkm1) = fsde3w_n(:,:,1:jpkm1)
+         !
+         fse3t (:,:,1:jpkm1) = fse3t_n (:,:,1:jpkm1)   ! vertical scale factors stored in fse3. arrays
+         fse3u (:,:,1:jpkm1) = fse3u_n (:,:,1:jpkm1)
+         fse3v (:,:,1:jpkm1) = fse3v_n (:,:,1:jpkm1)
+         fse3f (:,:,1:jpkm1) = fse3f_n (:,:,1:jpkm1)
+         fse3w (:,:,1:jpkm1) = fse3w_n (:,:,1:jpkm1)
+         fse3uw(:,:,1:jpkm1) = fse3uw_n(:,:,1:jpkm1)
+         fse3vw(:,:,1:jpkm1) = fse3vw_n(:,:,1:jpkm1)
+#else
          DO jk = 1, jpkm1
             fsdept(:,:,jk) = fsdept_n(:,:,jk)         ! now local depths stored in fsdep. arrays
@@ -144,10 +182,16 @@
             fse3vw(:,:,jk) = fse3vw_n(:,:,jk)
          END DO
+#endif
          !
          hu(:,:) = hu_0(:,:) + sshu_n(:,:)            ! now ocean depth (at u- and v-points)
          hv(:,:) = hv_0(:,:) + sshv_n(:,:)
          !                                            ! now masked inverse of the ocean depth (at u- and v-points)
+#if defined key_z_first
+         hur(:,:) = umask_1(:,:) / ( hu(:,:) + 1._wp - umask_1(:,:) )
+         hvr(:,:) = vmask_1(:,:) / ( hv(:,:) + 1._wp - vmask_1(:,:) )
+#else
          hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1._wp - umask(:,:,1) )
          hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1._wp - vmask(:,:,1) )
+#endif
          ! 
       ENDIF
@@ -162,12 +206,26 @@
       !                                           !------------------------------!
       zhdiv(:,:) = 0._wp
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1                           ! Horizontal divergence of barotropic transports
+               zhdiv(ji,jj) = zhdiv(ji,jj) + fse3t(ji,jj,jk) * hdivn(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
         zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)
       END DO
+#endif
       !                                                ! Sea surface elevation time stepping
       ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used
       ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp
       z1_rau0 = 0.5 / rau0
+#if defined key_z_first
+      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask_1(:,:)
+#else
       ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1)
+#endif
 
 #if defined key_agrif
@@ -189,4 +247,12 @@
          DO jj = 1, jpjm1
             DO ji = 1, jpim1      ! NO Vector Opt.
+#if defined key_z_first
+               sshu_a(ji,jj) = 0.5  * umask_1(ji,jj) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   &
+                  &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * ssha(ji  ,jj)     &
+                  &                                    + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) )
+               sshv_a(ji,jj) = 0.5  * vmask_1(ji,jj) / ( e1v(ji,jj  ) * e2v(ji,jj  ) )                   &
+                  &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * ssha(ji,jj  )     &
+                  &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )
+#else
                sshu_a(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   &
                   &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * ssha(ji  ,jj)     &
@@ -195,4 +261,5 @@
                   &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * ssha(ji,jj  )     &
                   &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )
+#endif
             END DO
          END DO
@@ -212,4 +279,19 @@
       !                                           !------------------------------!
       z1_2dt = 1.e0 / z2dt
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = jpkm1, 1, -1                      ! integrate from the bottom the hor. divergence
+                wn(ji,jj,jk) = wn(ji,jj,jk+1)                               &
+                   &         -   fse3t_n(ji,jj,jk) * hdivn(ji,jj,jk)        &
+                   &         - ( fse3t_a(ji,jj,jk) - fse3t_b(ji,jj,jk) )    &
+                   &            * tmask(ji,jj,jk) * z1_2dt
+#if defined key_bdy
+                wn(ji,jj,jk) = wn(ji,jj,jk) * bdytmask(ji,jj)
+#endif
+            END DO
+         END DO
+      END DO
+#else
       DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
          ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
@@ -221,4 +303,5 @@
 #endif
       END DO
+#endif
 
       !                                           !------------------------------!
@@ -231,7 +314,17 @@
          ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
          z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:)
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+                  z3d(ji,jj,jk) = wn(ji,jj,jk) * z2d(ji,jj)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpk
             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
          END DO
+#endif
          CALL iom_put( "w_masstr" , z3d                     )  
          CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
@@ -286,8 +379,15 @@
             DO jj = 1, jpjm1                                ! ssh now at f-point
                DO ji = 1, jpim1      ! NO Vector Opt.
+#if defined key_z_first
+                  sshf_n(ji,jj) = 0.5  * umask_1(ji,jj) * umask_1(ji,jj+1)                 &
+                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+#else
                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 &
                      &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
                      &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
                      &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+#endif
                END DO
             END DO
@@ -298,6 +398,11 @@
             DO jj = 1, jpj
                DO ji = 1, jpi                               ! before <-- now filtered
+#if defined key_z_first
+                  sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   &
+                     &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask_1(ji,jj)
+#else
                   sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   &
                      &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1)
+#endif
                   sshn  (ji,jj) = ssha  (ji,jj)             ! now <-- after
                   sshu_n(ji,jj) = sshu_a(ji,jj)
@@ -307,8 +412,15 @@
             DO jj = 1, jpjm1                                ! ssh now at f-point
                DO ji = 1, jpim1      ! NO Vector Opt.
+#if defined key_z_first
+                  sshf_n(ji,jj) = 0.5  * umask_1(ji,jj) * umask_1(ji,jj+1)                 &
+                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+#else
                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 &
                      &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
                      &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
                      &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+#endif
                END DO
             END DO
@@ -317,4 +429,12 @@
             DO jj = 1, jpjm1                                ! ssh before at u- & v-points
                DO ji = 1, jpim1      ! NO Vector Opt.
+#if defined key_z_first
+                  sshu_b(ji,jj) = 0.5  * umask_1(ji,jj) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   &
+                     &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
+                     &                                    + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )
+                  sshv_b(ji,jj) = 0.5  * vmask_1(ji,jj) / ( e1v(ji,jj  ) * e2v(ji,jj  ) )                   &
+                     &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
+                     &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )
+#else
                   sshu_b(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   &
                      &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
@@ -323,4 +443,5 @@
                      &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
                      &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )
+#endif
                END DO
             END DO
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 3211)
@@ -27,4 +27,9 @@
    REAL(wp), DIMENSION (4) ::   rcoef  = (/-1./6. , 1./2. ,-1./2. , 1./6. /)   !
    REAL(wp), DIMENSION (3) ::   scoef1 = (/  0.5  ,  0.5  ,  1.0  /)           !
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "flo_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 3211)
@@ -45,4 +45,7 @@
    INTEGER, PUBLIC  ::   nn_stockfl = 450        !: frequency of float restart file
 
+   !! * Control permutation of array indices
+#  include "flo_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce_ftrans.h90	(revision 3211)
@@ -0,0 +1,20 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  flo_oce_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   flo_oce.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS wb :I :I :z
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 3211)
@@ -28,4 +28,8 @@
    PUBLIC   flo_stp    ! routine called by step.F90
    PUBLIC   flo_init   ! routine called by opa.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "flo_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 3211)
@@ -22,4 +22,9 @@
 
    PUBLIC   flo_blk    ! routine called by floats.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "flo_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 3211)
@@ -24,4 +24,9 @@
 
    PUBLIC   flo_dom    ! routine called by floats.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "flo_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 3211)
@@ -33,4 +33,9 @@
    ! member arrays.
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztemp, zsal   ! 2D workspace
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "flo_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 3211)
@@ -19,5 +19,5 @@
    !!--------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain
-   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE lbclnk          ! lateral boundary condition / mpp exchanges
    USE iom_def         ! iom variables definitions
    USE iom_ioipsl      ! NetCDF format with IOIPSL library
@@ -34,4 +34,5 @@
    USE mod_attribut
 # endif
+   USE zpermute, ONLY : permute_z_last   ! Re-order a 3d array back to external (z-last) ordering
 
    IMPLICIT NONE
@@ -70,4 +71,7 @@
    END INTERFACE
 # endif
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -540,5 +544,5 @@
       INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
       INTEGER                        ::   ji, jj      ! loop counters
-      INTEGER                        ::   irankpv       ! 
+      INTEGER                        ::   irankpv     ! 
       INTEGER                        ::   ind1, ind2  ! substring index
       INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
@@ -551,4 +555,13 @@
       CHARACTER(LEN=100)             ::   clname      ! file name
       CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
+
+#if defined key_z_first
+      !! DCSE_NEMO: need a work array to match layout on disk, which is always z-last
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   wpv_r3d         ! copy of pv_r3d with dimensions permuted
+      INTEGER                                 ::   istat_wpv_r3d   ! result of attempt to allocate the above
+      INTEGER, DIMENSION(3)                   ::   ishape_pv_r3d   ! size of the dimensions of pv_r3d
+      INTEGER                                 ::   jk              ! loop counter
+#endif
+
       !---------------------------------------------------------------------
       !
@@ -670,10 +683,34 @@
          END DO
 
+#if defined key_z_first
+         !! DCSE_NEMO: Allocate 3d work-array with z-index last
+         !!            to match layout on disk
+         IF (PRESENT(pv_r3d)) THEN
+            ishape_pv_r3d = SHAPE(pv_r3d)
+            IF (ishape_pv_r3d(1) /= jpk) THEN
+               WRITE( ctmp1, FMT="('leading dimension is ',i5,', not ',i5,' (jpk) as expected')" ) &
+                  &  ishape_pv_r3d(1), jpk
+               CALL ctl_warn( trim(clinfo), 'beware: possible problem with 3d array, ', ctmp1 ) 
+            ENDIF
+            ALLOCATE(wpv_r3d(ishape_pv_r3d(2),ishape_pv_r3d(3),ishape_pv_r3d(1)),STAT=istat_wpv_r3d)
+            IF (istat_wpv_r3d /= 0) THEN
+               CALL ctl_stop( trim(clinfo), 'failed to allocate wpv_r3d' )
+            ENDIF
+         ENDIF
+#endif
+
          ! check that icnt matches the input array
          !-     
+
+         !! DCSE_NEMO: beware! want ishape to match wpv_r3d, not pv_r3d
+
          IF( idom == jpdom_unknown ) THEN
             IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
             IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
+#if defined key_z_first
+            IF( irankpv == 3 )        ishape(1:3) = SHAPE(wpv_r3d)
+#else
             IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
+#endif
             ctmp1 = 'd'
          ELSE
@@ -688,7 +725,21 @@
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
-               IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
-               ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
+#if defined key_z_first
+               IF( llnoov ) THEN
+                  ishape(1:3)=SHAPE(wpv_r3d(nldi:nlei,nldj:nlej,:))
+                  ctmp1='d(nldi:nlei,nldj:nlej,:)'
+               ELSE
+                  ishape(1:3)=SHAPE(wpv_r3d(1   :nlci,1   :nlcj,:))
+                  ctmp1='d(1:nlci,1:nlcj,:)'
                ENDIF
+#else
+               IF( llnoov ) THEN
+                  ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))
+                  ctmp1='d(nldi:nlei,nldj:nlej,:)'
+               ELSE
+                  ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:))
+                  ctmp1='d(1:nlci,1:nlcj,:)'
+               ENDIF
+#endif
             ENDIF
          ENDIF
@@ -720,4 +771,28 @@
          ENDIF
       
+#if defined key_z_first
+         SELECT CASE (iom_file(kiomid)%iolib)
+         CASE (jpioipsl )
+            IF  (PRESENT(pv_r3d)) THEN
+               CALL iom_ioipsl_get(  kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, wpv_r3d )
+            ELSE
+               CALL iom_ioipsl_get(  kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d )
+            ENDIF
+         CASE (jpnf90   )
+            IF (PRESENT(pv_r3d)) THEN
+               CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, wpv_r3d )
+            ELSE
+               CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d )
+            ENDIF
+         CASE (jprstdimg)
+            IF (PRESENT(pv_r3d)) THEN
+               CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, wpv_r3d )
+            ELSE
+               CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d )
+            ENDIF
+         CASE DEFAULT    
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+         END SELECT
+#else
          SELECT CASE (iom_file(kiomid)%iolib)
          CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
@@ -730,9 +805,26 @@
             CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
          END SELECT
+#endif
+
+#if defined key_z_first
+         !! DCSE_NEMO: if necessary, copy 3d work array back into pv_r3d,
+         !!            and de-allocate the work array
+         IF (PRESENT(pv_r3d)) THEN
+            ! This assumes that pv_r3d is not ftransed
+            DO jk = 1, ishape_pv_r3d(3)
+               DO jj = 1, ishape_pv_r3d(2)
+                  DO ji = 1, ishape_pv_r3d(1)
+                     pv_r3d(jk, ji, jj) = wpv_r3d(ji, jj, jk)
+                  ENDDO
+               ENDDO
+            ENDDO
+            DEALLOCATE(wpv_r3d)
+         ENDIF
+#endif
 
          IF( istop == nstop ) THEN   ! no additional errors until this point...
             IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i4,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
           
-            !--- overlap areas and extra hallows (mpp)
+            !--- overlap areas and extra haloes (mpp)
             IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
                CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
@@ -934,4 +1026,36 @@
       INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
       INTEGER :: ivid   ! variable id
+#if defined key_z_first
+      !! DCSE_NEMO: Need to transpose the dimensions of pvar from internal to external orderings
+      !  We do not use ftrans here
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)              ::   pvar_trans    ! transposed pvar
+      INTEGER                                              ::   ji, jj, jk    ! Dummy loop indices
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            IF (      (SIZE(pvar, DIM=1) /= jpk )   &
+               & .OR. (SIZE(pvar, DIM=2) /= jpi )   &
+               & .OR. (SIZE(pvar, DIM=3) /= jpj ) ) THEN
+               CALL ctl_stop( 'iom_rp3d: unexpected shape for variable ', cdvar )
+            END IF
+            ALLOCATE( pvar_trans(jpi, jpj, jpk) )
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     pvar_trans(ji, jj, jk) = pvar(jk, ji, jj)
+                  END DO
+               END DO
+            END DO
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar_trans )
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar_trans )
+            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar_trans )
+            CASE DEFAULT     
+               CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
+            END SELECT
+            DEALLOCATE( pvar_trans )
+         ENDIF
+      ENDIF
+#else
       IF( kiomid > 0 ) THEN
          IF( iom_file(kiomid)%nfid > 0 ) THEN
@@ -946,4 +1070,5 @@
          ENDIF
       ENDIF
+#endif
    END SUBROUTINE iom_rp3d
 
@@ -976,5 +1101,12 @@
       REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
 #if defined key_iomput
+#if defined key_z_first
+!FTRANS ASSERT :z :I
+!FTRANS pfield3d :I :I :z
+      CALL event__write_field3D( cdname, permute_z_last(pfield3d(nldi:nlei, nldj:nlej, :)) )
+#else
+!FTRANS ASSERT :I :z
       CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) )
+#endif
 #else
       IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90	(revision 3211)
@@ -35,4 +35,8 @@
       MODULE PROCEDURE iom_ioipsl_rp0123d
    END INTERFACE
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 3211)
@@ -40,4 +40,7 @@
       MODULE PROCEDURE iom_nf90_rp0123d
    END INTERFACE
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90	(revision 3211)
@@ -34,4 +34,7 @@
 
    INTEGER, PARAMETER ::   jpvnl          = 32   ! variable name length
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
       
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 3211)
@@ -28,4 +28,7 @@
    PUBLIC prt_ctl_info    ! called by all subroutines
    PUBLIC prt_ctl_init    ! called by opa.F90
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -77,4 +80,11 @@
       USE wrk_nemo, ONLY:   zmask1   => wrk_3d_11 , zmask2   => wrk_3d_12 
       USE wrk_nemo, ONLY:   ztab3d_1 => wrk_3d_13 , ztab3d_2 => wrk_3d_14
+
+      !! DCSE_NEMO: Need additional directives for renamed module variables
+!FTRANS zmask1 zmask2 ztab3d_1 ztab3d_2 :I :I :z
+
+!FTRANS tab3d_1 mask1 :I :I :z
+!FTRANS tab3d_2 mask2 :I :I :z
+
       !
       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1
@@ -120,4 +130,5 @@
       IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:)
       IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:)
+   !! DCSE_NEMO: attention!
       IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,:)
       IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,:)
@@ -209,4 +220,7 @@
    END SUBROUTINE prt_ctl
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
 
    SUBROUTINE prt_ctl_info (clinfo1, ivar1, clinfo2, ivar2, itime)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 3211)
@@ -35,4 +35,10 @@
    LOGICAL, PUBLIC ::   lrst_oce =  .FALSE.   !: logical to control the oce restart write 
    INTEGER, PUBLIC ::   numror, numrow        !: logical unit for cean restart (read and write)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trdmld_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/zpermute.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/zpermute.F90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/zpermute.F90	(revision 3211)
@@ -0,0 +1,91 @@
+MODULE zpermute
+   !!=====================================================================
+   !!                    ***  MODULE  zpermute ***
+   !! Manipulate array :  Library to read input files
+   !!====================================================================
+   !! History :  3.3.1  ! 2011 11  (S. Pickles) Original code
+   !!
+   !!--------------------------------------------------------------------
+   !!   permute_z_last : return pointer to a copy of an array with indices
+   !!                    permuted back to z_last ordering
+   !!--------------------------------------------------------------------
+   USE par_oce, ONLY : wp                   ! ocean parameters - working precision
+   USE lib_mpp, ONLY : ctl_warn, ctl_stop   ! warning and fatal messages
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC permute_z_last
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   FUNCTION permute_z_last( pain )   RESULT ( p_permuted )
+
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE permute_z_last  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+
+      REAL(wp), INTENT(in) :: pain(:,:,:)
+
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: pain_reordered 
+      REAL(wp), POINTER, DIMENSION(:,:,:)                   :: p_permuted
+ 
+      INTEGER, SAVE :: jiss=-1, jjss=-1, jkss=-1
+      INTEGER       :: jisz,    jjsz,    jksz
+      INTEGER       :: ji,      jj,      jk
+      INTEGER       :: ifail
+
+#if defined key_z_first
+      jisz = SIZE(pain, DIM=2)
+      jjsz = SIZE(pain, DIM=3)
+      jksz = SIZE(pain, DIM=1)
+#else
+      jisz = SIZE(pain, DIM=1)
+      jjsz = SIZE(pain, DIM=2)
+      jksz = SIZE(pain, DIM=3)
+#endif
+
+      IF ( (jiss /= jisz) .OR. (jjss /= jjsz) .OR. (jkss /= jksz)) THEN
+         IF (ALLOCATED(pain_reordered)) THEN
+            DEALLOCATE(pain_reordered)
+         END IF 
+      ELSE
+         IF (.NOT. ALLOCATED(pain_reordered)) THEN
+            CALL ctl_warn("permute_z_last: unexpected need to allocate array")
+         END IF
+      END IF
+
+      IF (.NOT. ALLOCATED(pain_reordered)) THEN
+         ALLOCATE(pain_reordered(jisz,jjsz,jksz), STAT=ifail)
+         IF (ifail /= 0) THEN
+            CALL ctl_stop("permute_z_last: failure allocating output array")
+         END IF 
+      END IF
+
+      DO jk = 1, jksz
+         DO jj = 1, jjsz
+            DO ji = 1, jisz
+!FTRANS pain :I :I :z
+               pain_reordered(ji, jj, jk) = pain(ji, jj, jk)
+            END DO
+         END DO
+      END DO
+
+      jiss = jisz
+      jjss = jjsz
+      jkss = jksz
+      p_permuted => pain_reordered
+
+   END FUNCTION permute_z_last
+
+   !!======================================================================
+END MODULE zpermute
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 3211)
@@ -54,4 +54,9 @@
 
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in Hormuz strait
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
    
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 3211)
@@ -60,5 +60,9 @@
    PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
    PUBLIC   lbc_lnk_e 
-   
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -81,6 +85,10 @@
       !!----------------------------------------------------------------------
       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign 
+!FTRANS pt3d1 :I :I :z
+!FTRANS pt3d2 :I :I :z
+! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
+      REAL(wp), INTENT(inout)   ::   pt3d1(jpi,jpj,jpk)   , pt3d2(jpi,jpj,jpk)
+      REAL(wp), INTENT(in   )   ::   psgn                 ! control of the sign 
       !!----------------------------------------------------------------------
       !
@@ -104,5 +112,8 @@
       !!----------------------------------------------------------------------
       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+!FTRANS pt3d :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      REAL(wp), INTENT(inout)                                   ::   pt3d(jpi,jpj,jpk)
       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 3211)
@@ -24,4 +24,7 @@
    PUBLIC   lbc_nfd   ! north fold conditions
 
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -47,4 +50,5 @@
       !                                                        !   = -1. , the sign is changed if north fold boundary
       !                                                        !   =  1. , the sign is kept  if north fold boundary
+!FTRANS pt3d :I :I :z
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
       !
@@ -59,5 +63,7 @@
       ijpjm1 = ijpj-1
 
+#if !defined key_z_first
       DO jk = 1, jpk
+#endif
          !
          SELECT CASE ( npolj )
@@ -69,30 +75,68 @@
                DO ji = 2, jpiglo
                   ijt = jpiglo-ji+2
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+                  END DO
+#else
                   pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+#endif
                END DO
                DO ji = jpiglo/2+1, jpiglo
                   ijt = jpiglo-ji+2
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+                  END DO
+#else
                   pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+#endif
                END DO
             CASE ( 'U' )                               ! U-point
                DO ji = 1, jpiglo-1
                   iju = jpiglo-ji+1
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
+                  END DO
+#else
                   pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
+#endif
                END DO
                DO ji = jpiglo/2, jpiglo-1
                   iju = jpiglo-ji+1
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+                  END DO
+#else
                   pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+#endif
                END DO
             CASE ( 'V' )                               ! V-point
                DO ji = 2, jpiglo
                   ijt = jpiglo-ji+2
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+                     pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
+                  END DO
+#else
                   pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
                   pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
+#endif
                END DO
             CASE ( 'F' )                               ! F-point
                DO ji = 1, jpiglo-1
                   iju = jpiglo-ji+1
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
+                     pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
+                  END DO
+#else
                   pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
                   pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
+#endif
                END DO
             END SELECT
@@ -104,28 +148,64 @@
                DO ji = 1, jpiglo
                   ijt = jpiglo-ji+1
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
+                  END DO
+#else
                   pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
+#endif
                END DO
             CASE ( 'U' )                               ! U-point
                DO ji = 1, jpiglo-1
                   iju = jpiglo-ji
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
+                  END DO
+#else
                   pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
+#endif
                END DO
             CASE ( 'V' )                               ! V-point
                DO ji = 1, jpiglo
                   ijt = jpiglo-ji+1
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+                  END DO
+#else
                   pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+#endif
                END DO
                DO ji = jpiglo/2+1, jpiglo
                   ijt = jpiglo-ji+1
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+                  END DO
+#else
                   pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+#endif
                END DO
             CASE ( 'F' )                               ! F-point
                DO ji = 1, jpiglo-1
                   iju = jpiglo-ji
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
+                  END DO
+#else
                   pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
+#endif
                END DO
                DO ji = jpiglo/2+1, jpiglo-1
                   iju = jpiglo-ji
+#if defined key_z_first
+                  DO jk = 1, jpk
+                     pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+                  END DO
+#else
                   pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+#endif
                END DO
             END SELECT
@@ -135,13 +215,24 @@
             SELECT CASE ( cd_type)
             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+#if defined key_z_first
+               pt3d(:, 1  ,:) = 0.e0
+               pt3d(:,ijpj,:) = 0.e0
+#else
                pt3d(:, 1  ,jk) = 0.e0
                pt3d(:,ijpj,jk) = 0.e0
+#endif
             CASE ( 'F' )                               ! F-point
+#if defined key_z_first
+               pt3d(:,ijpj,:) = 0.e0
+#else
                pt3d(:,ijpj,jk) = 0.e0
+#endif
             END SELECT
             !
          END SELECT     !  npolj
          !
+#if !defined key_z_first
       END DO
+#endif
       !
    END SUBROUTINE lbc_nfd_3d
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 3211)
@@ -129,5 +129,6 @@
    INTEGER ::   ngrp_znl        ! group ID for the znl processors
    INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
-   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, 
+   !                                                        ! number of the procs into the same znl domain
    
    ! North fold condition in mpp_mpi with jpni > 1
@@ -172,4 +173,19 @@
    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_e, znorthloc_e
    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_e
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+!! These arrays are all private to the module
+!FTRANS t4ns :I :I :z :I :I
+!FTRANS t4sn :I :I :z :I :I
+!FTRANS t4ew :I :I :z :I :I
+!FTRANS t4we :I :I :z :I :I
+!FTRANS t3ns :I :I :z :I
+!FTRANS t3sn :I :I :z :I
+!FTRANS t3ew :I :I :z :I
+!FTRANS t3we :I :I :z :I
+!FTRANS ztab :I :I :z
+!FTRANS znorthloc :I :I :z
+!FTRANS znorthgloio :I :I :z :I
 
    !!----------------------------------------------------------------------
@@ -347,5 +363,5 @@
 
 
-   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
+   SUBROUTINE mpp_lnk_3d( ptab3d, cd_type, psgn, cd_mpp, pval )
       !!----------------------------------------------------------------------
       !!                  ***  routine mpp_lnk_3d  ***
@@ -368,5 +384,8 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+!FTRANS ptab3d :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab3d   ! 3D array on which the boundary condition is applied
+      REAL(wp),                         INTENT(inout) ::   ptab3d(jpi,jpj,jpk)
       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
       !                                                             ! = T , U , V , F , W points
@@ -391,15 +410,26 @@
       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
          !
-         ! WARNING ptab is defined only between nld and nle
+         ! WARNING ptab3d is defined only between nld and nle
+#if defined key_z_first
+         DO jj = nlcj+1, jpj                    ! added line(s)   (inner only)
+            DO jk = 1, jpk
+#else
          DO jk = 1, jpk
             DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)   
-               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
-               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
+#endif
+               ptab3d(nldi  :nlei  , jj          ,jk) = ptab3d(nldi:nlei,     nlej,jk)   
+               ptab3d(1     :nldi-1, jj          ,jk) = ptab3d(nldi     ,     nlej,jk)
+               ptab3d(nlei+1:nlci  , jj          ,jk) = ptab3d(     nlei,     nlej,jk)
             END DO
+#if defined key_z_first
+         END DO
+         DO ji = nlci+1, jpi                    ! added column(s) (full)
+            DO jk = 1, jpk
+#else
             DO ji = nlci+1, jpi                 ! added column(s) (full)
-               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
-               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
-               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
+#endif
+               ptab3d(ji           ,nldj  :nlej  ,jk) = ptab3d(     nlei,nldj:nlej,jk)
+               ptab3d(ji           ,1     :nldj-1,jk) = ptab3d(     nlei,nldj     ,jk)
+               ptab3d(ji           ,nlej+1:jpj   ,jk) = ptab3d(     nlei,     nlej,jk)
             END DO
          END DO
@@ -410,13 +440,13 @@
          !                                        !* Cyclic east-west
          IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
+            ptab3d( 1 ,:,:) = ptab3d(jpim1,:,:)
+            ptab3d(jpi,:,:) = ptab3d(  2  ,:,:)
          ELSE                                     !* closed
-            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+            IF( .NOT. cd_type == 'F' )   ptab3d(     1       :jpreci,:,:) = zland    ! south except F-point
+                                         ptab3d(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
          ENDIF
          !                                   ! North-South boundaries (always closed)
-         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
-                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+         IF( .NOT. cd_type == 'F' )   ptab3d(:,     1       :jprecj,:) = zland       ! south except F-point
+                                      ptab3d(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
          !
       ENDIF
@@ -430,6 +460,6 @@
          iihom = nlci-nreci
          DO jl = 1, jpreci
-            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+            t3ew(:,jl,:,1) = ptab3d(jpreci+jl,:,:)
+            t3we(:,jl,:,1) = ptab3d(iihom +jl,:,:)
          END DO
       END SELECT  
@@ -462,14 +492,14 @@
       CASE ( -1 )
          DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            ptab3d(iihom+jl,:,:) = t3ew(:,jl,:,2)
          END DO
       CASE ( 0 ) 
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            ptab3d(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab3d(iihom+jl,:,:) = t3ew(:,jl,:,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab3d(jl      ,:,:) = t3we(:,jl,:,2)
          END DO
       END SELECT
@@ -483,6 +513,6 @@
          ijhom = nlcj-nrecj
          DO jl = 1, jprecj
-            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+            t3sn(:,jl,:,1) = ptab3d(:,ijhom +jl,:)
+            t3ns(:,jl,:,1) = ptab3d(:,jprecj+jl,:)
          END DO
       ENDIF
@@ -515,14 +545,14 @@
       CASE ( -1 )
          DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+            ptab3d(:,ijhom+jl,:) = t3ns(:,jl,:,2)
          END DO
       CASE ( 0 ) 
          DO jl = 1, jprecj
-            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+            ptab3d(:,jl      ,:) = t3sn(:,jl,:,2)
+            ptab3d(:,ijhom+jl,:) = t3ns(:,jl,:,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jprecj
-            ptab(:,jl,:) = t3sn(:,jl,:,2)
+            ptab3d(:,jl,:) = t3sn(:,jl,:,2)
          END DO
       END SELECT
@@ -535,6 +565,6 @@
          !
          SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab3d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab3d, cd_type, psgn )   ! for all northern procs.
          END SELECT
          !
@@ -742,5 +772,5 @@
       !!                  ***  routine mpp_lnk_3d_gather  ***
       !!
-      !! ** Purpose :   Message passing manadgement for two 3D arrays
+      !! ** Purpose :   Message passing management for two 3D arrays
       !!
       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
@@ -759,6 +789,11 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
+!FTRANS ptab1 :I :I :z
+!FTRANS ptab2 :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
+      REAL(wp),                         INTENT(inout) ::   ptab1(jpi,jpj,jpk)
+      REAL(wp),                         INTENT(inout) ::   ptab2(jpi,jpj,jpk)
       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
@@ -1113,5 +1148,5 @@
       !!                  ***  routine mppsend  ***
       !!                   
-      !! ** Purpose :   Send messag passing array
+      !! ** Purpose :   Send message passing array
       !!
       !!----------------------------------------------------------------------
@@ -1575,5 +1610,5 @@
 
 
-   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj ,kk)
+   SUBROUTINE mpp_minloc3d( ptab3d, pmask3d, pmin, ki, kj ,kk)
       !!------------------------------------------------------------------------
       !!             ***  routine mpp_minloc  ***
@@ -1585,6 +1620,11 @@
       !!
       !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
+!FTRANS ptab3d  :I :I :z
+!FTRANS pmask3d :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab3d       ! Local 3D array
+!     REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask3d      ! Local mask
+      REAL(wp), INTENT(in   )                          ::   ptab3d(jpi,jpj,jpk)
+      REAL(wp), INTENT(in   )                          ::   pmask3d(jpi,jpj,jpk)
       REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
       INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
@@ -1596,10 +1636,17 @@
       !!-----------------------------------------------------------------------
       !
-      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-      !
+      zmin  = MINVAL( ptab3d(:,:,:) , mask= pmask3d == 1.e0 )
+      ilocs = MINLOC( ptab3d(:,:,:) , mask= pmask3d == 1.e0 )
+      !
+!! DCSE_NEMO: Attention! 
+#if defined key_z_first
+      ki = ilocs(2) + nimpp - 1
+      kj = ilocs(3) + njmpp - 1
+      kk = ilocs(1)
+#else
       ki = ilocs(1) + nimpp - 1
       kj = ilocs(2) + njmpp - 1
       kk = ilocs(3)
+#endif
       !
       zain(1,:)=zmin
@@ -1655,5 +1702,5 @@
 
 
-   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
+   SUBROUTINE mpp_maxloc3d( ptab3d, pmask3d, pmax, ki, kj, kk )
       !!------------------------------------------------------------------------
       !!             ***  routine mpp_maxloc  ***
@@ -1665,6 +1712,11 @@
       !!
       !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
+!FTRANS ptab3d  :I :I :z
+!FTRANS pmask3d :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab3d       ! Local 2D array
+!     REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask3d      ! Local mask
+      REAL(wp), INTENT(in   )                          ::   ptab3d(jpi,jpj,jpk)       ! Local 2D array
+      REAL(wp), INTENT(in   )                          ::   pmask3d(jpi,jpj,jpk)      ! Local mask
       REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
       INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
@@ -1676,10 +1728,17 @@
       !!-----------------------------------------------------------------------
       !
-      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-      !
+      zmax  = MAXVAL( ptab3d(:,:,:) , mask= pmask3d == 1.e0 )
+      ilocs = MAXLOC( ptab3d(:,:,:) , mask= pmask3d == 1.e0 )
+      !
+!! DCSE_NEMO: Attention!
+#if defined key_z_first
+      ki = ilocs(2) + nimpp - 1
+      kj = ilocs(3) + njmpp - 1
+      kk = ilocs(1)
+#else
       ki = ilocs(1) + nimpp - 1
       kj = ilocs(2) + njmpp - 1
       kk = ilocs(3)
+#endif
       !
       zain(1,:)=zmax
@@ -1731,5 +1790,5 @@
       !!                  ***  routine mppobc  ***
       !! 
-      !! ** Purpose :   Message passing manadgement for open boundary
+      !! ** Purpose :   Message passing management for open boundary
       !!     conditions array
       !!
@@ -1748,5 +1807,7 @@
       !!----------------------------------------------------------------------
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY:   ztab => wrk_2d_1
+!! DCSE_NEMO: Warning! ztab is also a lib_mpp module variable
+!     USE wrk_nemo, ONLY:   ztab => wrk_2d_1
+      USE wrk_nemo, ONLY:   ztab2d => wrk_2d_1
       !
       INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices
@@ -1775,5 +1836,5 @@
       ! boundary condition initialization
       ! ---------------------------------
-      ztab(:,:) = 0.e0
+      ztab2d(:,:) = 0.e0
       !
       IF( ktype==1 ) THEN                                  ! north/south boundaries
@@ -1805,5 +1866,5 @@
             DO jj = ijpt0, ijpt1
                DO ji = iipt0, iipt1
-                  ztab(ji,jj) = ptab(ji,jk)
+                  ztab2d(ji,jj) = ptab(ji,jk)
                END DO
             END DO
@@ -1811,5 +1872,5 @@
             DO jj = ijpt0, ijpt1
                DO ji = iipt0, iipt1
-                  ztab(ji,jj) = ptab(jj,jk)
+                  ztab2d(ji,jj) = ptab(jj,jk)
                END DO
             END DO
@@ -1823,6 +1884,6 @@
             iihom = nlci-nreci
             DO jl = 1, jpreci
-               t2ew(:,jl,1) = ztab(jpreci+jl,:)
-               t2we(:,jl,1) = ztab(iihom +jl,:)
+               t2ew(:,jl,1) = ztab2d(jpreci+jl,:)
+               t2we(:,jl,1) = ztab2d(iihom +jl,:)
             END DO
          ENDIF
@@ -1853,10 +1914,10 @@
          IF( nbondi == 0 .OR. nbondi == 1 ) THEN
             DO jl = 1, jpreci
-               ztab(jl,:) = t2we(:,jl,2)
+               ztab2d(jl,:) = t2we(:,jl,2)
             END DO
          ENDIF
          IF( nbondi == -1 .OR. nbondi == 0 ) THEN
             DO jl = 1, jpreci
-               ztab(iihom+jl,:) = t2ew(:,jl,2)
+               ztab2d(iihom+jl,:) = t2ew(:,jl,2)
             END DO
          ENDIF
@@ -1869,6 +1930,6 @@
             ijhom = nlcj-nrecj
             DO jl = 1, jprecj
-               t2sn(:,jl,1) = ztab(:,ijhom +jl)
-               t2ns(:,jl,1) = ztab(:,jprecj+jl)
+               t2sn(:,jl,1) = ztab2d(:,ijhom +jl)
+               t2ns(:,jl,1) = ztab2d(:,jprecj+jl)
             END DO
          ENDIF
@@ -1898,10 +1959,10 @@
          IF( nbondj == 0 .OR. nbondj == 1 ) THEN
             DO jl = 1, jprecj
-               ztab(:,jl) = t2sn(:,jl,2)
+               ztab2d(:,jl) = t2sn(:,jl,2)
             END DO
          ENDIF
          IF( nbondj == 0 .OR. nbondj == -1 ) THEN
             DO jl = 1, jprecj
-               ztab(:,ijhom+jl) = t2ns(:,jl,2)
+               ztab2d(:,ijhom+jl) = t2ns(:,jl,2)
             END DO
          ENDIF
@@ -1909,5 +1970,5 @@
             DO jj = ijpt0, ijpt1            ! north/south boundaries
                DO ji = iipt0,ilpt1
-                  ptab(ji,jk) = ztab(ji,jj)  
+                  ptab(ji,jk) = ztab2d(ji,jj)  
                END DO
             END DO
@@ -1915,5 +1976,5 @@
             DO jj = ijpt0, ilpt1            ! east/west boundaries
                DO ji = iipt0,iipt1
-                  ptab(jj,jk) = ztab(ji,jj) 
+                  ptab(jj,jk) = ztab2d(ji,jj) 
                END DO
             END DO
@@ -2201,5 +2262,8 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
+!FTRANS pt3d :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
+      REAL(wp),                         INTENT(inout) ::   pt3d(jpi,jpj,jpk)
       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
       !                                                              !   = T ,  U , V , F or W  gridpoints
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 3211)
@@ -22,4 +22,7 @@
    PUBLIC mpp_init       ! called by opa.F90
    PUBLIC mpp_init2      ! called by opa.F90
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
@@ -142,5 +145,5 @@
       !  Computation of local domain sizes ilcit() ilcjt()
       !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
+      !  The subdomains are squares lesser than or equal to the global
       !  dimensions divided by the number of processors minus the overlap
       !  array (cf. par_oce.F90).
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 3211)
@@ -32,4 +32,10 @@
      MODULE PROCEDURE ldf_zpf_1d, ldf_zpf_1d_3d, ldf_zpf_3d
   END INTERFACE
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
 
    !! * Substitutions
@@ -207,4 +213,5 @@
       REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1)
       REAL(wp), INTENT(in   ), DIMENSION          (:) ::   pdep       ! depth of the gridpoint (T, U, V, F)
+!FTRANS pah :I :I :z
       REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile
       !!
@@ -248,4 +255,5 @@
       REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection
       REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1)
+!FTRANS pdep pah :I :I :z
       REAL(wp), INTENT(in   ), DIMENSION      (:,:,:) ::   pdep       ! dep of the gridpoint (T, U, V, F)
       REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 3211)
@@ -35,4 +35,7 @@
 #endif
 
+   !! * Control permutation of array indices
+#  include "ldfdyn_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce_ftrans.h90	(revision 3211)
@@ -0,0 +1,22 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  ldfdyn_oce_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   ldfdyn_oce.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+#if defined key_dynldf_c3d
+!FTRANS ahm1 ahm2 ahm3 ahm4 :I :I :z
+#endif
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 3211)
@@ -20,4 +20,5 @@
 #    define   fsahmu(i,j,k)    ahm3(i,j,k)
 #    define   fsahmv(i,j,k)    ahm4(i,j,k)
+#    include "ldfdyn_oce_ftrans.h90"
 #elif defined key_dynldf_c2d
 !   ' key_dynldf_c2d' :                 2D coefficient
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 3211)
@@ -31,4 +31,11 @@
    PUBLIC   ldf_eiv    ! routine called by step.F90
    
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -84,6 +91,6 @@
       ! ----------------------------------------
       IF( ln_traldf_grif ) THEN
-         DO jk = 1, jpk
 #  if defined key_vectopt_loop  
+         DO jk = 1, jpk
 !CDIR NOVERRCHK 
             DO ji = 1, jpij   ! vector opt.
@@ -100,8 +107,16 @@
                zhw(ji,1) = zhw(ji,1) + ze3w
             END DO
+         END DO
 #  else
+#     if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpk
+#     else
+         DO jk = 1, jpk
             DO jj = 2, jpjm1
 !CDIR NOVERRCHK 
                DO ji = 2, jpim1
+#     endif
                   ! Take the max of N^2 and zero then take the vertical sum 
                   ! of the square root of the resulting N^2 ( required to compute 
@@ -117,9 +132,9 @@
                END DO
             END DO
+         END DO
 #  endif
-         END DO
       ELSE
-         DO jk = 1, jpk
 #  if defined key_vectopt_loop  
+         DO jk = 1, jpk
 !CDIR NOVERRCHK 
             DO ji = 1, jpij   ! vector opt.
@@ -137,8 +152,16 @@
                zhw(ji,1) = zhw(ji,1) + ze3w
             END DO
+         END DO
 #  else
+#     if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpk
+#     else
+         DO jk = 1, jpk
             DO jj = 2, jpjm1
 !CDIR NOVERRCHK 
                DO ji = 2, jpim1
+#     endif
                   ! Take the max of N^2 and zero then take the vertical sum 
                   ! of the square root of the resulting N^2 ( required to compute 
@@ -155,6 +178,6 @@
                END DO
             END DO
+         END DO
 #  endif
-         END DO
       END IF
 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 3211)
@@ -46,6 +46,8 @@
    !                                                                !! Griffies operator
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   &
+             &   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   &
+             &   triadi  , triadj     !: isoneutral slopes relative to model-coordinate
 
    !                                                              !! Madec operator
@@ -62,4 +64,14 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   zdzrho , zdyrho, zdxrho     ! Horizontal and vertical density gradients
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only
+
+   !! * Control permutation of array indices
+#  include "ldfslp_ftrans.h90"
+!FTRANS zdxrho :I :I :z :
+!FTRANS zdyrho :I :I :z :
+!FTRANS zdzrho :I :I :z :
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
 
    !! * Substitutions
@@ -119,6 +131,15 @@
       USE oce     , ONLY:   zgrv => ta       , zwz => sa   ! (ta,sa) used as workspace
       USE wrk_nemo, ONLY:   zdzr => wrk_3d_1               ! 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zgru :I :I :z
+!FTRANS zww  :I :I :z
+!FTRANS zgrv :I :I :z
+!FTRANS zwz  :I :I :z
+!FTRANS zdzr :I :I :z
+
       !!
       INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index
+!FTRANS prd :I :I :z
+!FTRANS pn2 :I :I :z
       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   prd   ! in situ density
       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   pn2   ! Brunt-Vaisala frequency (locally ref.)
@@ -145,7 +166,13 @@
       zwz(:,:,:) = 0._wp
       !
+#if defined key_z_first
+      DO jj = 1, jpjm1           !==   i- & j-gradient of density   ==!
+         DO ji = 1, jpim1
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) ) 
                zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) ) 
@@ -154,5 +181,6 @@
       END DO
       IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level
-# if defined key_vectopt_loop  
+!! DCSE_NEMO: Attention! key_vectopt_loop will break key_z_first
+# if ( defined key_vectopt_loop ) && ! ( defined key_z_first ) 
          DO jj = 1, 1
             DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
@@ -167,4 +195,15 @@
       ENDIF
       !
+#if defined key__first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zdzr(ji,jj,1) = 0._wp   !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
+            DO jk = 2, jpkm1
+               zdzr(ji,jj,jk) = zm1_g * ( prd(ji,jj,jk) + 1._wp )              &
+                  &                   * ( pn2(ji,jj,jk) + pn2(ji,jj,jk+1) ) * ( 1._wp - 0.5_wp * tmask(ji,jj,jk+1) )
+            END DO
+         END DO
+      END DO
+#else
       zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
       DO jk = 2, jpkm1
@@ -177,4 +216,5 @@
             &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) )
       END DO
+#endif
       !
       !                          !==   Slopes just below the mixed layer   ==!
@@ -185,7 +225,13 @@
       ! ===========================      | vslp = d/dj( prd ) / d/dz( prd )
       !               
+#if defined key_z_first
+      DO jj = 2, jpjm1               !* Slopes at u and v points
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1                            !* Slopes at u and v points
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                !                                      ! horizontal and vertical density gradient at u- and v-points
                zau = zgru(ji,jj,jk) / e1u(ji,jj)
@@ -223,7 +269,13 @@
       !
       !                                            !* horizontal Shapiro filter
+#if defined key_z_first
+      DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+         DO ji = 2, jpim1  
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
             DO ji = 2, jpim1  
+#endif
                uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
                   &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
@@ -238,6 +290,13 @@
             END DO
          END DO
+#if defined key_z_first
+      END DO
+      DO jj = 3, jpj-2                               ! other rows
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
          DO jj = 3, jpj-2                               ! other rows
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
                   &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
@@ -252,7 +311,15 @@
             END DO
          END DO
+#if defined key_z_first
+      END DO
+      !                                           !* decrease along coastal boundaries
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
          !                                        !* decrease along coastal boundaries
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
                   &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp
@@ -267,7 +334,13 @@
       ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd )
       !               
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                !                                  !* Local vertical density gradient evaluated from N^2
                zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
@@ -305,7 +378,13 @@
       !
       !                                           !* horizontal Shapiro filter
+#if defined key_z_first
+      DO jj = 2, jpjm1, MAX(1, jpj-3)                           ! rows jj=2 and =jpjm1 only
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
             DO ji = 2, jpim1
+#endif
                wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
                   &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
@@ -321,6 +400,13 @@
             END DO
          END DO  
+#if defined key_z_first
+      END DO
+      DO jj = 3, jpj-2                                  ! other rows
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
          DO jj = 3, jpj-2                               ! other rows
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
                   &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
@@ -336,7 +422,15 @@
             END DO
          END DO
+#if defined key_z_first
+      END DO
+      !                                           !* decrease along coastal boundaries
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
          !                                        !* decrease along coastal boundaries
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
                   &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
@@ -383,4 +477,14 @@
    END SUBROUTINE ldf_slp
    
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "ldfslp_ftrans.h90"
+!FTRANS zdxrho :I :I :z :
+!FTRANS zdyrho :I :I :z :
+!FTRANS zdzrho :I :I :z :
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
 
    SUBROUTINE ldf_slp_grif ( kt )
@@ -404,4 +508,13 @@
       USE wrk_nemo, ONLY:   zalpha  => wrk_3d_4 , zbeta => wrk_3d_5    ! alpha, beta at T points, at depth fsgdept
       USE wrk_nemo, ONLY:   z1_mlbw => wrk_2d_1
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zdit   :I :I :z
+!FTRANS zdis   :I :I :z
+!FTRANS zdjt   :I :I :z
+!FTRANS zdjs   :I :I :z
+!FTRANS zdkt   :I :I :z
+!FTRANS zdks   :I :I :z
+!FTRANS zalpha :I :I :z
+!FTRANS zbeta  :I :I :z
       !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
@@ -426,7 +539,13 @@
       CALL eos_alpbet( tsb, zalpha, zbeta )     !==  before thermal and haline expension coeff. at T-points  ==!
       !
+#if defined key_z_first
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            DO jk = 1, jpkm1                    !==  before lateral T & S gradients at T-level jk  ==!
+#else
       DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==!
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                zdit(ji,jj,jk) = ( tb(ji+1,jj,jk) - tb(ji,jj,jk) ) * umask(ji,jj,jk)   ! i-gradient of T and S at jj
                zdis(ji,jj,jk) = ( sb(ji+1,jj,jk) - sb(ji,jj,jk) ) * umask(ji,jj,jk)
@@ -437,5 +556,5 @@
       END DO
       IF( ln_zps ) THEN                               ! partial steps: correction at the last level
-# if defined key_vectopt_loop
+# if ( defined key_vectopt_loop ) && ! ( defined key_z_first )
          DO jj = 1, 1
             DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
@@ -452,4 +571,16 @@
       ENDIF
       !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zdkt(ji,jj,1) = 0._wp            !==  before vertical T & S gradient at w-level  ==!
+            zdks(ji,jj,1) = 0._wp
+            DO jk = 2, jpk
+               zdkt(ji,jj,jk) = ( tb(ji,jj,jk-1) - tb(ji,jj,jk) ) * tmask(ji,jj,jk)
+               zdks(ji,jj,jk) = ( sb(ji,jj,jk-1) - sb(ji,jj,jk) ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       zdkt(:,:,1) = 0._wp                    !==  before vertical T & S gradient at w-level  ==!
       zdks(:,:,1) = 0._wp
@@ -458,11 +589,18 @@
          zdks(:,:,jk) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk)
       END DO
+#endif
       !
       !
       DO jl = 0, 1                           !==  density i-, j-, and k-gradients  ==!
          ip = jl   ;   jp = jl         ! guaranteed nonzero gradients ( absolute value larger than repsln)
+#if defined key_z_first
+         DO jj = 1, jpjm1                          ! NB: not masked due to the minimum value set
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1                    ! done each pair of triad
+#else
          DO jk = 1, jpkm1                          ! done each pair of triad
             DO jj = 1, jpjm1                       ! NB: not masked due to the minimum value set
                DO ji = 1, fs_jpim1   ! vector opt. 
+#endif
                   zdxrho_raw = ( zalpha(ji+ip,jj   ,jk) * zdit(ji,jj,jk) + zbeta(ji+ip,jj   ,jk) * zdis(ji,jj,jk) ) / e1u(ji,jj)
                   zdyrho_raw = ( zalpha(ji   ,jj+jp,jk) * zdjt(ji,jj,jk) + zbeta(ji   ,jj+jp,jk) * zdjs(ji,jj,jk) ) / e2v(ji,jj)
@@ -474,7 +612,13 @@
       END DO
      DO kp = 0, 1                           !==  density i-, j-, and k-gradients  ==!
+#if defined key_z_first
+         DO jj = 1, jpj                         ! NB: not masked due to the minimum value set
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1                    ! done each pair of triad
+#else
          DO jk = 1, jpkm1                          ! done each pair of triad
             DO jj = 1, jpj                       ! NB: not masked due to the minimum value set
                DO ji = 1, jpi   ! vector opt. 
+#endif
                   zdzrho_raw = ( zalpha(ji,jj,jk) * zdkt(ji,jj,jk+kp) + zbeta(ji,jj,jk) * zdks(ji,jj,jk+kp) )   &
                      &       / fse3w(ji,jj,jk+kp)
@@ -530,7 +674,13 @@
          DO jl = 0, 1
             ip = jl   ;   jp = jl         ! i- and j-indices of triads (i-k and j-k planes)
+#if defined key_z_first
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 1, jpjm1
                   DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                      !
                      ! Calculate slope relative to geopotentials used for GM skew fluxes
@@ -605,4 +755,14 @@
    END SUBROUTINE ldf_slp_grif
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "ldfslp_ftrans.h90"
+!FTRANS zdxrho :I :I :z :
+!FTRANS zdyrho :I :I :z :
+!FTRANS zdzrho :I :I :z :
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
 
    SUBROUTINE ldf_slp_mxl( prd, pn2, p_gru, p_grv, p_dzr )
@@ -622,4 +782,9 @@
       !!                omlmask         :  mixed layer mask
       !!----------------------------------------------------------------------
+!FTRANS prd   :I :I :z
+!FTRANS pn2   :I :I :z
+!FTRANS p_gru :I :I :z
+!FTRANS p_grv :I :I :z
+!FTRANS p_dzr :I :I :z
       REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   prd            ! in situ density
       REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pn2            ! Brunt-Vaisala frequency (locally ref.)
@@ -646,5 +811,5 @@
       !                          !==   surface mixed layer mask   !
       DO jk = 1, jpk                      ! =1 inside the mixed layer, =0 otherwise
-# if defined key_vectopt_loop
+# if ( defined key_vectopt_loop ) && ! ( defined key_z_first )
          DO jj = 1, 1
             DO ji = 1, jpij   ! vector opt. (forced unrolling)
@@ -672,5 +837,5 @@
       !-----------------------------------------------------------------------
       !
-# if defined key_vectopt_loop
+# if ( defined key_vectopt_loop ) && ! ( defined key_z_first )
       DO jj = 1, 1
          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
@@ -727,4 +892,14 @@
    END SUBROUTINE ldf_slp_mxl
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "ldfslp_ftrans.h90"
+!FTRANS zdxrho :I :I :z :
+!FTRANS zdyrho :I :I :z :
+!FTRANS zdzrho :I :I :z :
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
 
    SUBROUTINE ldf_slp_init
@@ -780,7 +955,13 @@
             ! set the slope of diffusion to the slope of s-surfaces
             !      ( c a u t i o n : minus sign as fsdep has positive value )
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 1, jpk
+#else
             DO jk = 1, jpk
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk)
                      vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_ftrans.h90	(revision 3211)
@@ -0,0 +1,31 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  ldfslp_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices for
+   !!   public multi-dimensional arrays with a z-dimension declared in module
+   !!   ldfslp.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+
+!FTRANS triadi_g :I :I :z : :
+!FTRANS triadj_g :I :I :z : :
+!FTRANS wslp2 :I :I :z
+!FTRANS triadi :I :I :z : :
+!FTRANS triadj :I :I :z : :
+!FTRANS uslp :I :I :z
+!FTRANS vslp :I :I :z
+!FTRANS wslpi :I :I :z
+!FTRANS wslpj :I :I :z
+!FTRANS omlmask :I :I :z
+
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 3211)
@@ -29,4 +29,10 @@
 
    PUBLIC   ldf_tra_init   ! called by opa.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 3211)
@@ -36,11 +36,15 @@
 
 #if defined key_traldf_c3d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtt, ahtu, ahtv, ahtw   !: ** 3D coefficients ** at T-,U-,V-,W-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtt, ahtu, ahtv, ahtw   !: ** 3D coefficients **
+   !                                                                                   !  at T-,U-,V-,W-points
 #elif defined key_traldf_c2d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients ** at T-,U-,V-,W-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients **
+   !                                                                                   !  at T-,U-,V-,W-points
 #elif defined key_traldf_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** at T-,U-,V-,W-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** 
+   !                                                                                   !  at T-,U-,V-,W-points
 #else
-   REAL(wp), PUBLIC                                      ::   ahtt, ahtu, ahtv, ahtw   !: ** 0D coefficients ** at T-,U-,V-,W-points
+   REAL(wp), PUBLIC                                      ::   ahtt, ahtu, ahtv, ahtw   !: ** 0D coefficients ** !
+   !                                                                                   !  at T-,U-,V-,W-points
 #endif
 
@@ -72,4 +76,7 @@
    REAL(wp), PUBLIC            ::   aeiu, aeiv, aeiw            !: eddy induced coef. (not used)
 #endif
+
+   !! * Control permutation of array indices
+#  include "ldftra_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce_ftrans.h90	(revision 3211)
@@ -0,0 +1,34 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  ldftra_oce_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   ldftra_oce.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+
+#if defined key_traldf_c3d
+!FTRANS ahtt ahtu ahtv ahtw :I :I :z
+#endif
+
+#if defined key_traldf_eiv
+#if defined key_traldf_c3d 
+!FTRANS aeiu aeiv aeiw :I :I :z
+#endif
+#endif
+
+#if defined key_diaeiv
+!FTRANS u_eiv v_eiv w_eiv :I :I :z
+#endif
+
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 3211)
@@ -219,4 +219,7 @@
       !                                                   !  (repsectively) at the south OB (u_cynbnd = cx rdt )
    REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   usmsk, vsmsk, tsmsk  !: 2D mask for the South OB
+
+   !! * Control permutation of array indices
+#  include "obc_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce_ftrans.h90	(revision 3211)
@@ -0,0 +1,86 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  obc_oce_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   oce.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+
+!! East open boundary
+!FTRANS ufoe :I :z 
+!FTRANS vfoe :I :z 
+!FTRANS tfoe :I :z 
+!FTRANS sfoe :I :z 
+!FTRANS uclie :I :z 
+!! Arrays for radiative East OBC
+!FTRANS uebnd :I :z : :
+!FTRANS vebnd :I :z : :
+!FTRANS tebnd :I :z : :
+!FTRANS sebnd :I :z : :
+!FTRANS u_cxebnd :I :z
+!FTRANS v_cxebnd :I :z
+!FTRANS uemsk :I :z
+!FTRANS vemsk :I :z
+!FTRANS temsk :I :z
+!! West open boundary
+!FTRANS ufow :I :z
+!FTRANS vfow :I :z
+!FTRANS tfow :I :z
+!FTRANS sfow :I :z
+!FTRANS ucliw :I :z
+!! Arrays for radiative West OBC
+!FTRANS uwbnd :I :z : :
+!FTRANS vwbnd :I :z : :
+!FTRANS twbnd :I :z : :
+!FTRANS swbnd :I :z : :
+!FTRANS u_cxwbnd :I :z
+!FTRANS v_cxwbnd :I :z
+!FTRANS uwmsk :I :z
+!FTRANS vwmsk :I :z
+!FTRANS twmsk :I :z
+!! North open boundary
+!FTRANS ufon :I :z
+!FTRANS vfon :I :z
+!FTRANS tfon :I :z
+!FTRANS sfon :I :z
+!FTRANS vclin :I :z
+!! Arrays for radiative North OBC
+!FTRANS unbnd :I :z : :
+!FTRANS vnbnd :I :z : :
+!FTRANS tnbnd :I :z : :
+!FTRANS snbnd :I :z : :
+!FTRANS u_cynbnd :I :z
+!FTRANS v_cynbnd :I :z
+!FTRANS unmsk :I :z
+!FTRANS vnmsk :I :z
+!FTRANS tnmsk :I :z
+!! South open boundary
+!FTRANS ufos :I :z
+!FTRANS vfos :I :z
+!FTRANS tfos :I :z
+!FTRANS sfos :I :z
+!FTRANS vclis :I :z
+!! Arrays for radiative South OBC
+!FTRANS usbnd :I :z : :
+!FTRANS vsbnd :I :z : :
+!FTRANS tsbnd :I :z : :
+!FTRANS ssbnd :I :z : :
+!FTRANS u_cysbnd :I :z
+!FTRANS v_cysbnd :I :z
+!FTRANS usmsk :I :z
+!FTRANS vsmsk :I :z
+!FTRANS tsmsk :I :z
+
+
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90	(revision 3211)
@@ -2,5 +2,5 @@
    !!                 ***  obc_vectopt_loop_substitute.h90  ***
    !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop starting and inding indices 
+   !! ** purpose :   substitute the inner loop starting and ending indices 
    !!      to allow unrolling of do-loop using CPP macro.
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90	(revision 3211)
@@ -54,7 +54,7 @@
    INTEGER ::   nt_m=0, ntobc_m
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtedta, vbtedta, sshedta    ! East
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtwdta, vbtwdta, sshwdta	   ! West
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtndta, vbtndta, sshndta	   ! North
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtsdta, vbtsdta, sshsdta	   ! South
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtwdta, vbtwdta, sshwdta    ! West
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtndta, vbtndta, sshndta    ! North
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtsdta, vbtsdta, sshsdta    ! South
    ! arrays used for interpolating time dependent data on the boundaries
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uedta, vedta, tedta, sedta    ! East
@@ -68,4 +68,18 @@
    LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltnmsk, lunmsk, lvnmsk  ! checks
    LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltsmsk, lusmsk, lvsmsk
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+   !! No public arrays in this module require index permutation
+!FTRANS uedta vedta tedta sedta :I :z :
+!FTRANS uwdta vwdta twdta swdta :I :z :
+!FTRANS undta vndta tndta sndta :I :z :
+!FTRANS usdta vsdta tsdta ssdta :I :z :
+!FTRANS ltemsk luemsk lvemsk :I :z
+!FTRANS ltwmsk luwmsk lvwmsk :I :z
+!FTRANS ltnmsk lunmsk lvnmsk :I :z
+!FTRANS ltsmsk lusmsk lvsmsk :I :z
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn.F90	(revision 3211)
@@ -45,4 +45,9 @@
    REAL(wp) ::   rtaue  , rtauw  , rtaun  , rtaus  ,  &
                  rtauein, rtauwin, rtaunin, rtausin
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    !!---------------------------------------------------------------------------------
@@ -147,7 +152,13 @@
          ! 1.1 U zonal velocity    
          ! --------------------
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = nie0, nie1
+               DO jk = 1, jpkm1
+#else
          DO ji = nie0, nie1
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + &
                                  uemsk(jj,jk)*ufoe(jj,jk)
@@ -158,7 +169,13 @@
          ! 1.2 V meridional velocity
          ! -------------------------
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = nie0+1, nie1+1
+               DO jk = 1, jpkm1
+#else
          DO ji = nie0+1, nie1+1
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   va(ji,jj,jk) = va(ji,jj,jk) * (1.-vemsk(jj,jk)) + &
                                  vfoe(jj,jk)*vemsk(jj,jk)
@@ -191,7 +208,13 @@
          ! ... radiative conditions on the total part + relaxation toward climatology
          ! ... (jpjedp1, jpjefm1),jpieob
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = nie0, nie1
+               DO jk = 1, jpkm1
+#else
          DO ji = nie0, nie1
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   z05cx = u_cxebnd(jj,jk)
                   z05cx = z05cx / e1t(ji,jj)
@@ -229,7 +252,13 @@
          ! ... radiative condition
          ! ... (jpjedp1, jpjefm1), jpieob+1
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = nie0+1, nie1+1
+               DO jk = 1, jpkm1
+#else
          DO ji = nie0+1, nie1+1
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   z05cx = v_cxebnd(jj,jk) 
                   z05cx = z05cx / e1f(ji-1,jj)
@@ -289,7 +318,13 @@
          ! 1.1 U zonal velocity
          ! ---------------------
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = niw0, niw1
+               DO jk = 1, jpkm1
+#else
          DO ji = niw0, niw1
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + &
                                  uwmsk(jj,jk)*ufow(jj,jk)
@@ -300,7 +335,13 @@
          ! 1.2 V meridional velocity
          ! -------------------------
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = niw0, niw1
+               DO jk = 1, jpkm1
+#else
          DO ji = niw0, niw1
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   va(ji,jj,jk) = va(ji,jj,jk) * (1.-vwmsk(jj,jk)) + &
                                  vfow(jj,jk)*vwmsk(jj,jk)
@@ -333,7 +374,13 @@
          ! ... radiative conditions on the total part + relaxation toward climatology
          ! ... (jpjwdp1, jpjwfm1), jpiwob
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = niw0, niw1
+               DO jk = 1, jpkm1
+#else
          DO ji = niw0, niw1
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   z05cx = u_cxwbnd(jj,jk)
                   z05cx = z05cx / e1t(ji+1,jj)
@@ -370,7 +417,13 @@
          ! ... radiative condition plus Raymond-Kuo
          ! ... (jpjwdp1, jpjwfm1),jpiwob
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = niw0, niw1
+               DO jk = 1, jpkm1
+#else
          DO ji = niw0, niw1
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   z05cx = v_cxwbnd(jj,jk)  
                   z05cx = z05cx / e1f(ji,jj)
@@ -429,6 +482,11 @@
          ! --------------------
          DO jj = njn0+1, njn1+1
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   ua(ji,jj,jk)= ua(ji,jj,jk) * (1.-unmsk(ji,jk)) + &
                                 ufon(ji,jk)*unmsk(ji,jk)
@@ -440,6 +498,11 @@
          ! -------------------------
          DO jj = njn0, njn1
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + &
                                 vfon(ji,jk)*vnmsk(ji,jk)
@@ -474,6 +537,11 @@
          ! ... jpjnob+1,(jpindp1, jpinfm1)
          DO jj = njn0+1, njn1+1
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   z05cx= u_cynbnd(ji,jk) 
                   z05cx = z05cx / e2f(ji, jj-1)
@@ -518,6 +586,11 @@
          ! ... jpjnob,(jpindp1, jpinfm1)
          DO jj = njn0, njn1
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
          ! ... 2* gradj(v) (T-point i=nibm, time mean)
                   z05cx = v_cynbnd(ji,jk)
@@ -580,6 +653,11 @@
          ! --------------------
          DO jj = njs0, njs1
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   ua(ji,jj,jk)= ua(ji,jj,jk) * (1.-usmsk(ji,jk)) + &
                                 usmsk(ji,jk) * ufos(ji,jk)
@@ -591,6 +669,11 @@
          ! -------------------------
          DO jj = njs0, njs1
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + &
                                 vsmsk(ji,jk) * vfos(ji,jk)
@@ -624,6 +707,11 @@
          ! ... jpjsob,(jpisdp1, jpisfm1)
          DO jj = njs0, njs1
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   z05cx= u_cysbnd(ji,jk) 
                   z05cx = z05cx / e2f(ji, jj)
@@ -665,6 +753,11 @@
          ! ... jpjsob,(jpisdp1,jpisfm1)
          DO jj = njs0, njs1
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   z05cx = v_cysbnd(ji,jk)
                   z05cx = z05cx / e2t(ji,jj+1)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90	(revision 3211)
@@ -32,4 +32,9 @@
 
    PUBLIC   obc_dyn_bt  ! routine called in dynnxt (explicit free surface case)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -92,7 +97,13 @@
       !!----------------------------------------------------------------------
 
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = nie0, nie1
+            DO jk = 1, jpkm1
+#else
       DO ji = nie0, nie1
          DO jk = 1, jpkm1
             DO jj = 1, jpj
+#endif
                ua(ji,jj,jk) = ua(ji,jj,jk) + sqrt( grav*hur (ji,jj) )               &
                   &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  &
@@ -123,6 +134,11 @@
       !
       DO ji = niw0, niw1
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpj
+#endif
                ua(ji,jj,jk) = ua(ji,jj,jk) - sqrt( grav*hur (ji,jj) )               &
                   &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  &
@@ -151,6 +167,11 @@
       !
       DO jj = njn0, njn1
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
                va(ji,jj,jk) = va(ji,jj,jk) + sqrt( grav*hvr (ji,jj) )               &
                   &                      * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5  &
@@ -181,6 +202,11 @@
       !
       DO jj = njs0, njs1
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
                va(ji,jj,jk) = va(ji,jj,jk) - sqrt( grav*hvr (ji,jj) )               &
                   &                       * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5 &
@@ -209,13 +235,24 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = nie0, nie1
+             DO jk = 1, jpkm1
+#else
       DO ji = nie0, nie1
          DO jk = 1, jpkm1
             DO jj = 1, jpj
+#endif
                ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfoe_b(ji,jj) ) * uemsk(jj,jk)
             END DO
          END DO
       END DO
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = nie0p1, nie1p1
+#else
       DO ji = nie0p1, nie1p1
          DO jj = 1, jpj
+#endif
             sshn(ji,jj) = sshn(ji,jj) * (1.-temsk(jj,1)) + temsk(jj,1)*sshn_b(ji,jj)
          END DO
@@ -236,4 +273,18 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfow_b(ji,jj) ) * uwmsk(jj,jk)
+            END DO
+         END DO
+      END DO
+      DO jj = 1, jpj
+         DO ji = niw0, niw1
+            sshn(ji,jj) = sshn(ji,jj) * (1.-twmsk(jj,1)) + twmsk(jj,1)*sshn_b(ji,jj)
+         END DO
+      END DO
+#else
       DO ji = niw0, niw1
          DO jk = 1, jpkm1
@@ -246,4 +297,5 @@
          END DO
       END DO
+#endif
       !
    END SUBROUTINE obc_dyn_bt_west
@@ -262,7 +314,13 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_z_first
       DO jj = njn0, njn1
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
+      DO jj = njn0, njn1
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
                va(ji,jj,jk) = ( va(ji,jj,jk) + sshfon_b(ji,jj) ) * vnmsk(jj,jk)
             END DO
@@ -291,6 +349,11 @@
       !
       DO jj = njs0, njs1
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
                va(ji,jj,jk) = ( va(ji,jj,jk) + sshfos_b(ji,jj) ) * vsmsk(jj,jk)
             END DO
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90	(revision 3211)
@@ -30,4 +30,9 @@
 
    PUBLIC   obc_fla_ts   ! routine called in dynspg_ts (free surface time splitting case)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90	(revision 3211)
@@ -28,4 +28,9 @@
 
    PUBLIC   obc_init   ! routine called by opa.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90	(revision 3211)
@@ -35,4 +35,9 @@
       nitm  = 2,   & ! nitm   = before
       nitm2 = 3      ! nitm2  = before-before
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -114,6 +119,11 @@
 
          ! ... advance in time (time filter, array swap) 
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpj
+#endif
                uebnd(jj,jk,nib  ,nitm2) = uebnd(jj,jk,nib  ,nitm)*uemsk(jj,jk)
                uebnd(jj,jk,nibm ,nitm2) = uebnd(jj,jk,nibm ,nitm)*uemsk(jj,jk)
@@ -159,6 +169,11 @@
 
          ! ... advance in time (time filter, array swap)
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpj
+#endif
          ! ... fields nitm2 <== nitm
                vebnd(jj,jk,nib  ,nitm2) = vebnd(jj,jk,nib  ,nitm)*vemsk(jj,jk)
@@ -169,6 +184,11 @@
 
          DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   vebnd(jj,jk,nib  ,nitm) = vebnd(jj,jk,nib,  nit)*vemsk(jj,jk)
                   vebnd(jj,jk,nibm ,nitm) = vebnd(jj,jk,nibm ,nit)*vemsk(jj,jk)
@@ -201,6 +221,11 @@
 
          ! ... advance in time (time filter, array swap)
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpj
+#endif
          ! ... fields nitm <== nit  plus time filter at the boundary
                tebnd(jj,jk,nib,nitm) = tebnd(jj,jk,nib,nit)*temsk(jj,jk)
@@ -210,6 +235,11 @@
 
          DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   tebnd(jj,jk,nibm,nitm) = tebnd(jj,jk,nibm,nit)*temsk(jj,jk)
                   sebnd(jj,jk,nibm,nitm) = sebnd(jj,jk,nibm,nit)*temsk(jj,jk)
@@ -266,6 +296,11 @@
          ! ... (jpjedp1, jpjefm1),jpieob
          DO ji = fs_nie0, fs_nie1 ! Vector opt.
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
+#endif
          ! ... 2* gradi(u) (T-point i=nibm, time mean)
                   z2dx = ( uebnd(jj,jk,nibm ,nit) + uebnd(jj,jk,nibm ,nitm2) &
@@ -302,6 +337,11 @@
          ! ... (jpjedp1, jpjefm1), jpieob+1
          DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
+#endif
          ! ... 2* i-gradient of v (f-point i=nibm, time mean)
                   z2dx = ( vebnd(jj,jk,nibm ,nit) + vebnd(jj,jk,nibm ,nitm2) &
@@ -378,6 +418,11 @@
 
          ! ... advance in time (time filter, array swap) 
+#if defined key_z_first
+         DO jj = 1, jpj 
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpj 
+#endif
                uwbnd(jj,jk,nib  ,nitm2) = uwbnd(jj,jk,nib  ,nitm)*uwmsk(jj,jk)
                uwbnd(jj,jk,nibm ,nitm2) = uwbnd(jj,jk,nibm ,nitm)*uwmsk(jj,jk)
@@ -388,6 +433,11 @@
          ! ... fields nitm <== nit  plus time filter at the boundary 
          DO ji = fs_niw0, fs_niw1 ! Vector opt.
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   uwbnd(jj,jk,nib  ,nitm) = uwbnd(jj,jk,nib  ,nit)*uwmsk(jj,jk)
                   uwbnd(jj,jk,nibm ,nitm) = uwbnd(jj,jk,nibm ,nit)*uwmsk(jj,jk)
@@ -425,6 +475,11 @@
 
          ! ... advance in time (time filter, array swap)
+#if defined key_z_first
          DO jk = 1, jpkm1
             DO jj = 1, jpj 
+#else
+         DO jj = 1, jpj 
+            DO jk = 1, jpkm1
+#endif
          ! ... fields nitm2 <== nitm
                   vwbnd(jj,jk,nib  ,nitm2) = vwbnd(jj,jk,nib  ,nitm)*vwmsk(jj,jk)
@@ -435,6 +490,11 @@
 
          DO ji = fs_niw0, fs_niw1 ! Vector opt.
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   vwbnd(jj,jk,nib  ,nitm) = vwbnd(jj,jk,nib,  nit)*vwmsk(jj,jk)
                   vwbnd(jj,jk,nibm ,nitm) = vwbnd(jj,jk,nibm ,nit)*vwmsk(jj,jk)
@@ -467,6 +527,11 @@
  
          ! ... advance in time (time filter, array swap)
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpj
+#endif
          ! ... fields nitm <== nit  plus time filter at the boundary
                twbnd(jj,jk,nib,nitm) = twbnd(jj,jk,nib,nit)*twmsk(jj,jk)
@@ -476,6 +541,11 @@
  
          DO ji = fs_niw0, fs_niw1 ! Vector opt.
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   twbnd(jj,jk,nibm ,nitm) = twbnd(jj,jk,nibm ,nit)*twmsk(jj,jk)
                   swbnd(jj,jk,nibm ,nitm) = swbnd(jj,jk,nibm ,nit)*twmsk(jj,jk)
@@ -534,6 +604,11 @@
          ! ... (jpjwdp1, jpjwfm1), jpiwob
          DO ji = fs_niw0, fs_niw1 ! Vector opt.
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
+#endif
          ! ... 2* gradi(u) (T-point i=nibm, time mean)
                   z2dx = ( - uwbnd(jj,jk,nibm ,nit) -  uwbnd(jj,jk,nibm ,nitm2) &
@@ -571,6 +646,11 @@
          ! ... (jpjwdp1, jpjwfm1),jpiwob
          DO ji = fs_niw0, fs_niw1 ! Vector opt.
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
+#endif
          ! ... 2* i-gradient of v (f-point i=nibm, time mean)
                   z2dx = ( - vwbnd(jj,jk,nibm ,nit) - vwbnd(jj,jk,nibm ,nitm2) &
@@ -647,6 +727,11 @@
 
          ! ... advance in time (time filter, array swap)
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
          ! ... fields nitm2 <== nitm
                unbnd(ji,jk,nib  ,nitm2) = unbnd(ji,jk,nib  ,nitm)*unmsk(ji,jk)
@@ -657,6 +742,11 @@
 
          DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   unbnd(ji,jk,nib  ,nitm) = unbnd(ji,jk,nib,  nit)*unmsk(ji,jk)
                   unbnd(ji,jk,nibm ,nitm) = unbnd(ji,jk,nibm ,nit)*unmsk(ji,jk)
@@ -689,6 +779,11 @@
 
          ! ... advance in time (time filter, array swap) 
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
          ! ... fields nitm2 <== nitm 
                vnbnd(ji,jk,nib  ,nitm2) = vnbnd(ji,jk,nib  ,nitm)*vnmsk(ji,jk)
@@ -699,6 +794,11 @@
 
          DO jj = fs_njn0, fs_njn1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   vnbnd(ji,jk,nib  ,nitm) = vnbnd(ji,jk,nib,  nit)*vnmsk(ji,jk)
                   vnbnd(ji,jk,nibm ,nitm) = vnbnd(ji,jk,nibm ,nit)*vnmsk(ji,jk)
@@ -736,6 +836,11 @@
 
          ! ... advance in time (time filter, array swap)
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
          ! ... fields nitm <== nit  plus time filter at the boundary
                tnbnd(ji,jk,nib ,nitm) = tnbnd(ji,jk,nib,nit)*tnmsk(ji,jk)
@@ -745,6 +850,11 @@
 
          DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   tnbnd(ji,jk,nibm ,nitm) = tnbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk)
                   snbnd(ji,jk,nibm ,nitm) = snbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk)
@@ -803,6 +913,11 @@
          ! ... jpjnob+1,(jpindp1, jpinfm1)
          DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 2, jpim1
+#endif
          ! ... 2* j-gradient of u (f-point i=nibm, time mean)
                   z2dx = ( unbnd(ji,jk,nibm ,nit) + unbnd(ji,jk,nibm ,nitm2) &
@@ -860,6 +975,11 @@
          ! ... jpjnob,(jpindp1, jpinfm1)
          DO jj = fs_njn0, fs_njn1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 2, jpim1
+#endif
          ! ... 2* gradj(v) (T-point i=nibm, time mean)
                   ii = ji -1 + nimpp
@@ -921,6 +1041,11 @@
 
          ! ... advance in time (time filter, array swap)
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
          ! ... fields nitm2 <== nitm
                   usbnd(ji,jk,nib  ,nitm2) = usbnd(ji,jk,nib  ,nitm)*usmsk(ji,jk)
@@ -931,6 +1056,11 @@
  
          DO jj = fs_njs0, fs_njs1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   usbnd(ji,jk,nib  ,nitm) = usbnd(ji,jk,nib,  nit)*usmsk(ji,jk)
                   usbnd(ji,jk,nibm ,nitm) = usbnd(ji,jk,nibm ,nit)*usmsk(ji,jk)
@@ -963,6 +1093,11 @@
  
          !.. advance in time (time filter, array swap) 
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
          ! ... fields nitm2 <== nitm 
                vsbnd(ji,jk,nib  ,nitm2) = vsbnd(ji,jk,nib  ,nitm)*vsmsk(ji,jk)
@@ -972,6 +1107,11 @@
 
          DO jj = fs_njs0, fs_njs1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   vsbnd(ji,jk,nib  ,nitm) = vsbnd(ji,jk,nib,  nit)*vsmsk(ji,jk)
                   vsbnd(ji,jk,nibm ,nitm) = vsbnd(ji,jk,nibm ,nit)*vsmsk(ji,jk)
@@ -1008,6 +1148,11 @@
 
          ! ... advance in time (time filter, array swap)
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO ji = 1, jpi
+#endif
          ! ... fields nitm <== nit  plus time filter at the boundary
                tsbnd(ji,jk,nib,nitm) = tsbnd(ji,jk,nib,nit)*tsmsk(ji,jk)
@@ -1017,6 +1162,11 @@
 
          DO jj = fs_njs0, fs_njs1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   tsbnd(ji,jk,nibm ,nitm) = tsbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk)
                   ssbnd(ji,jk,nibm ,nitm) = ssbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk)
@@ -1075,6 +1225,11 @@
          ! ... jpjsob,(jpisdp1, jpisfm1)
          DO jj = fs_njs0, fs_njs1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 2, jpim1
+#endif
          ! ... 2* j-gradient of u (f-point i=nibm, time mean)
                   z2dx = (- usbnd(ji,jk,nibm ,nit) - usbnd(ji,jk,nibm ,nitm2) &
@@ -1132,6 +1287,11 @@
          ! ... jpjsob,(jpisdp1,jpisfm1)
          DO jj = fs_njs0, fs_njs1 ! Vector opt.
+#if defined key_z_first
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 2, jpim1
+#endif
          ! ... 2* gradj(v) (T-point i=nibm, time mean)
                   z2dx = ( - vsbnd(ji,jk,nibm ,nit) - vsbnd(ji,jk,nibm ,nitm2) &
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90	(revision 3211)
@@ -20,4 +20,9 @@
    PUBLIC   obc_rst_read    ! routine called by obc_ini
    PUBLIC   obc_rst_write   ! routine called by step
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90	(revision 3211)
@@ -43,4 +43,9 @@
       rtauein, rtauwin, rtaunin, rtausin      ! Boundary restoring coefficient for inflow 
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "obc_vectopt_loop_substitute.h90"
@@ -140,7 +145,13 @@
 
       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+               DO jk = 1, jpkm1
+#else
          DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - temsk(jj,jk)) + &
                                  tfoe(jj,jk)*temsk(jj,jk)
@@ -178,7 +189,13 @@
          !     tial velocity (here vn), which have been saved in (u_cxebnd,v_cxebnd)
          ! ... (jpjedp1, jpjefm1), jpieob+1
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+               DO jk = 1, jpkm1
+#else
          DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
+#endif
          ! ... i-phase speed ratio (from averaged of v_cxebnd)
                   z05cx = ( 0.5 * ( v_cxebnd(jj,jk) + v_cxebnd(jj-1,jk) ) ) / e1t(ji-1,jj)
@@ -241,7 +258,13 @@
       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN
 
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = fs_niw0, fs_niw1 ! Vector opt.
+               DO jk = 1, jpkm1
+#else
          DO ji = fs_niw0, fs_niw1 ! Vector opt.
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - twmsk(jj,jk)) + &
                                  tfow(jj,jk)*twmsk(jj,jk)
@@ -278,7 +301,13 @@
          ! ... the phase velocity is taken as the phase velocity of the tangen-
          ! ... tial velocity (here vn), which have been saved in (v_cxwbnd)
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = fs_niw0, fs_niw1 ! Vector opt.
+               DO jk = 1, jpkm1
+#else
          DO ji = fs_niw0, fs_niw1 ! Vector opt.
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
+#endif
          ! ... i-phase speed ratio (from averaged of v_cxwbnd)
                   z05cx = (  0.5 * ( v_cxwbnd(jj,jk) + v_cxwbnd(jj-1,jk) ) ) / e1t(ji+1,jj)
@@ -341,6 +370,11 @@
 
          DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tnmsk(ji,jk)) + &
                                 tnmsk(ji,jk) * tfon(ji,jk)
@@ -379,6 +413,11 @@
          ! ... jpjnob+1,(jpindp1, jpinfm1)
          DO jj = fs_njn0+1, fs_njn1+1 ! Vector opt.
+#if defined key_z_first
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 2, jpim1
+#endif
          ! ... j-phase speed ratio (from averaged of vtnbnd)
          !        (bounded by 1)
@@ -443,6 +482,11 @@
 
          DO jj = fs_njs0, fs_njs1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) + &
                                 tsmsk(ji,jk) * tfos(ji,jk)
@@ -480,6 +524,11 @@
          !... jpjsob,(jpisdp1, jpisfm1)
          DO jj = fs_njs0, fs_njs1  ! Vector opt.
+#if defined key_z_first
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 2, jpim1
+#endif
          !... j-phase speed ratio (from averaged of u_cysbnd)
          !       (bounded by 1)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcvol.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcvol.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcvol.F90	(revision 3211)
@@ -24,4 +24,10 @@
    PUBLIC obc_vol        ! routine called by dynspg_flt
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -108,7 +114,13 @@
       ! ... East open boundary
       IF( lp_obc_east ) THEN                      ! ... Total transport through the East OBC
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = fs_nie0, fs_nie1 ! Vector opt.
+               DO jk = 1, jpkm1
+#else
          DO ji = fs_nie0, fs_nie1 ! Vector opt.
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   zubtpecor = zubtpecor - ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) * &
              &     uemsk(jj,jk)*MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
@@ -120,7 +132,13 @@
       ! ... West open boundary
       IF( lp_obc_west ) THEN                      ! ... Total transport through the West OBC
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = fs_niw0, fs_niw1 ! Vector opt.
+               DO jk = 1, jpkm1
+#else
          DO ji = fs_niw0, fs_niw1 ! Vector opt.
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   zubtpecor = zubtpecor + ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) * &
              &    uwmsk(jj,jk) *MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
@@ -128,11 +146,17 @@
             END DO
          END DO
-       ENDIF
+      ENDIF
 
       ! ... North open boundary
       IF( lp_obc_north ) THEN                     ! ... Total transport through the North OBC
+#if defined key_z_first
+         DO ji = 1, jpi
+            DO jj = fs_njn0, fs_njn1 ! Vector opt.
+               DO jk = 1, jpkm1
+#else
          DO jj = fs_njn0, fs_njn1 ! Vector opt.
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   zubtpecor = zubtpecor - va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) * &
              &    vnmsk(ji,jk) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
@@ -140,11 +164,16 @@
             END DO
          END DO
-       ENDIF
+      ENDIF
 
       ! ... South open boundary
       IF( lp_obc_south ) THEN                     ! ... Total transport through the South OBC
          DO jj = fs_njs0, fs_njs1 ! Vector opt.
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   zubtpecor = zubtpecor + va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) * &
              &    vsmsk(ji,jk) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
@@ -152,5 +181,5 @@
             END DO
          END DO
-       ENDIF
+      ENDIF
 
       IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain
@@ -185,7 +214,13 @@
       IF( lp_obc_west ) THEN
          ! ... correction of the west velocity
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = fs_niw0, fs_niw1 ! Vector opt.
+               DO jk = 1, jpkm1
+#else
          DO ji = fs_niw0, fs_niw1 ! Vector opt.
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   ua(ji,jj,jk) = ua(ji,jj,jk) - zubtpecor*uwmsk(jj,jk)
                   ztransw= ztransw + ua(ji,jj,jk)*fse3u(ji,jj,jk)*e2u(ji,jj)*uwmsk(jj,jk) * &
@@ -203,7 +238,13 @@
 
          ! ... correction of the east velocity
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = fs_nie0, fs_nie1 ! Vector opt.
+               DO jk = 1, jpkm1
+#else
          DO ji = fs_nie0, fs_nie1 ! Vector opt.
             DO jk = 1, jpkm1
                DO jj = 1, jpj
+#endif
                   ua(ji,jj,jk) = ua(ji,jj,jk) + zubtpecor*uemsk(jj,jk)
                   ztranse= ztranse + ua(ji,jj,jk)*fse3u(ji,jj,jk)*e2u(ji,jj)*uemsk(jj,jk) * &
@@ -225,6 +266,11 @@
          ! ... correction of the north velocity
          DO jj = fs_njn0, fs_njn1 ! Vector opt.
+#if defined key_z_first
+            DO ji =  1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji =  1, jpi
+#endif
                   va(ji,jj,jk) = va(ji,jj,jk) + zubtpecor*vnmsk(ji,jk)
                   ztransn= ztransn + va(ji,jj,jk)*fse3v(ji,jj,jk)*e1v(ji,jj)*vnmsk(ji,jk) * &
@@ -245,6 +291,11 @@
          ! ... correction of the south velocity
          DO jj = fs_njs0, fs_njs1 ! Vector opt.
+#if defined key_z_first
+            DO ji =  1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji =  1, jpi
+#endif
                   va(ji,jj,jk) = va(ji,jj,jk) - zubtpecor*vsmsk(ji,jk)
                   ztranss= ztranss + va(ji,jj,jk)*fse3v(ji,jj,jk)*e1v(ji,jj)*vsmsk(ji,jk) * &
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 3211)
@@ -19,5 +19,4 @@
    USE in_out_manager           ! I/O manager
    USE par_oce
-   USE dom_oce                  ! Ocean space and time domain variables
    USE obs_read_prof            ! Reading and allocation of observations (Coriolis)
    USE obs_read_sla             ! Reading and allocation of SLA observations  
@@ -105,4 +104,7 @@
    LOGICAL, DIMENSION(:), ALLOCATABLE :: &
       & ld_velav     !: Velocity data is daily averaged
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -1023,4 +1025,10 @@
       USE wrk_nemo, ONLY: frld => wrk_2d_1
 #endif
+
+   !! * Control permutation of array indices
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
+#  include "oce_ftrans.h90"
+
       IMPLICIT NONE
 
@@ -1081,7 +1089,13 @@
       IF ( ln_sla ) THEN
          DO jslaset = 1, nslasets
+#if defined key_z_first
+            CALL obs_sla_opt( sladatqc(jslaset),            &
+               &              kstp, jpi, jpj, nit000, sshn, &
+               &              tmask_1(:,:), n2dint )
+#else
             CALL obs_sla_opt( sladatqc(jslaset),            &
                &              kstp, jpi, jpj, nit000, sshn, &
                &              tmask(:,:,1), n2dint )
+#endif
          END DO         
       ENDIF
@@ -1090,7 +1104,13 @@
       IF ( ln_sst ) THEN
          DO jsstset = 1, nsstsets
+#if defined key_z_first
+            CALL obs_sst_opt( sstdatqc(jsstset),                 &
+               &              kstp, jpi, jpj, nit000, tn(:,:,1), &
+               &              tmask_1(:,:), n2dint )
+#else
             CALL obs_sst_opt( sstdatqc(jsstset),                 &
                &              kstp, jpi, jpj, nit000, tn(:,:,1), &
                &              tmask(:,:,1), n2dint )
+#endif
          END DO
       ENDIF
@@ -1427,4 +1447,7 @@
          & rdt
 
+   !! * Control permutation of array indices
+!FTRANS CLEAR
+
       IMPLICIT NONE
 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 3211)
@@ -24,4 +24,7 @@
 
    INTEGER, DIMENSION(:,:), ALLOCATABLE ::   mppmap   ! ???
+
+   !! * Control permutation of array indices
+   !! No array indices to control
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 3211)
@@ -85,4 +85,7 @@
       & grid_search_file    ! file name head for grid search lookup 
 
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -128,31 +131,47 @@
          ELSE
             IF ( cdgrid == 'T' ) THEN
-               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
-                  &                             nldi, nlei,nldj,  nlej,   &
-                  &                             nproc, jpnij,             &
-                  &                             glamt, gphit, tmask,      &
-                  &                             kobsin, plam, pphi,       &
-                  &                             kobsi, kobsj, kproc )
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,        &
+                  &                     nldi, nlei,nldj,  nlej,          &
+                  &                     nproc, jpnij,                    &
+#if defined key_z_first
+                  &                     glamt, gphit, tmask_1(:,:),      &
+#else
+                  &                     glamt, gphit, tmask(:,:,1),      &
+#endif
+                  &                     kobsin, plam, pphi,              &
+                  &                     kobsi, kobsj, kproc )
             ELSEIF ( cdgrid == 'U' ) THEN
-               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
-                  &                             nldi, nlei,nldj,  nlej,   &
-                  &                             nproc, jpnij,             &
-                  &                             glamu, gphiu, umask,      &
-                  &                             kobsin, plam, pphi,       &
-                  &                             kobsi, kobsj, kproc )
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,        &
+                  &                     nldi, nlei,nldj,  nlej,          &
+                  &                     nproc, jpnij,                    &
+#if defined key_z_first
+                  &                     glamu, gphiu, umask_1(:,:),      &
+#else
+                  &                     glamu, gphiu, umask(:,:,1),      &
+#endif
+                  &                     kobsin, plam, pphi,              &
+                  &                     kobsi, kobsj, kproc )
             ELSEIF ( cdgrid == 'V' ) THEN
-               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
-                  &                             nldi, nlei,nldj,  nlej,   &
-                  &                             nproc, jpnij,             &
-                  &                             glamv, gphiv, vmask,      &
-                  &                             kobsin, plam, pphi,       &
-                  &                             kobsi, kobsj, kproc )
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,        &
+                  &                     nldi, nlei,nldj,  nlej,          &
+                  &                     nproc, jpnij,                    &
+#if defined key_z_first
+                  &                     glamv, gphiv, vmask_1(:,:),      &
+#else
+                  &                     glamv, gphiv, vmask(:,:,1),      &
+#endif
+                  &                     kobsin, plam, pphi,              &
+                  &                     kobsi, kobsj, kproc )
             ELSEIF ( cdgrid == 'F' ) THEN
-               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
-                  &                             nldi, nlei,nldj,  nlej,   &
-                  &                             nproc, jpnij,             &
-                  &                             glamf, gphif, fmask,      &
-                  &                             kobsin, plam, pphi,       &
-                  &                             kobsi, kobsj, kproc )
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,        &
+                  &                     nldi, nlei,nldj,  nlej,          &
+                  &                     nproc, jpnij,                    &
+#if defined key_z_first
+                  &                     glamf, gphif, fmask_1(:,:),      &
+#else
+                  &                     glamf, gphif, fmask(:,:,1),      &
+#endif
+                  &                     kobsin, plam, pphi,              &
+                  &                     kobsi, kobsj, kproc )
             ELSE
                CALL ctl_stop( 'Grid not supported' )
@@ -283,5 +302,9 @@
                zlamg(mig(ji),mjg(jj)) = glamt(ji,jj)
                zphig(mig(ji),mjg(jj)) = gphit(ji,jj)
+#if defined key_z_first
+               zmskg(mig(ji),mjg(jj)) = tmask_1(ji,jj)
+#else
                zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1)
+#endif
             END DO
          END DO
@@ -295,5 +318,9 @@
                zlamg(ji,jj) = glamt(ji,jj)
                zphig(ji,jj) = gphit(ji,jj)
+#if defined key_z_first
+               zmskg(ji,jj) = tmask_1(ji,jj)
+#else
                zmskg(ji,jj) = tmask(ji,jj,1)
+#endif
             END DO
          END DO
@@ -813,9 +840,9 @@
             END DO
             
-            CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,  &
-               &                     nldi, nlei,nldj,  nlej,    &
-               &                     nproc, jpnij,              &
-               &                     glamt, gphit, tmask,       &
-               &                     nlons*nlats, lonsi, latsi, &
+            CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,   &
+               &                     nldi, nlei,nldj,  nlej,     &
+               &                     nproc, jpnij,               &
+               &                     glamt, gphit, tmask(:,:,1), &
+               &                     nlons*nlats, lonsi, latsi,  &
                &                     ixposi, iyposi, iproci )
             
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 3211)
@@ -26,4 +26,7 @@
       &   obs_int_comm_2d    ! Get 2D interpolation stencil
    
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -58,14 +61,26 @@
       INTEGER, INTENT(IN) :: kpk       ! Number of levels
       INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
-         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdi, &         ! i,j indices for each stencil
          & kgrdj
       INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
          & kproc            ! Precomputed processor for each i,j,iobs points
-      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
-         & pval             ! Local 3D array to extract data from
+
+!! DCSE_NEMO: This style defeats ftrans
+!      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+!        & pval             ! Local 3D array to extract data from
+!FTRANS pval :I :I :z
+      REAL(KIND=wp), INTENT(IN) ::&
+         & pval(jpi,jpj,kpk) ! Local 3D array to extract data from
       REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
          & pgval            ! Stencil at each point
       !! * Local declarations
       
+#if defined key_z_first
+      IF ( kpk /= jpk ) THEN
+         CALL ctl_stop( 'Error in obs_int_comm_3d', &
+            &           'index reordering requires that jpk==kpk' )
+      ENDIF
+#endif
+
       IF (ln_grid_global) THEN
          
@@ -107,4 +122,11 @@
       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY: wrk_3d_1
+
+   !! * Control permutation of array indices
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
+!FTRANS wrk_3d_1 :I :I :z
+!FTRANS zval :I :I :z
+
       !!
       !! * Arguments
@@ -132,5 +154,6 @@
          RETURN
       END IF
-      zval => wrk_3d_1(:,:,1:1)
+
+      zval => wrk_3d_1
 
       ! Set up local "3D" buffer
@@ -139,4 +162,8 @@
 
       ! Call the 3D version
+
+!! DCSE_NEMO: this is not going to work with index re-ordering
+!! Really want obs_int_comm_2d to do its own stuff, instead of calling
+!! obs_int_comm_3d !!
 
       IF (PRESENT(kproc)) THEN
@@ -184,12 +211,27 @@
       INTEGER, INTENT(IN) :: kpk       ! Number of levels
       INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
-         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdi, &         ! i,j indices for each stencil
          & kgrdj
       INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
          & kproc            ! Precomputed processor for each i,j,iobs points
-      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
-         & pval             ! Local 3D array to extract data from
-      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
-         & pgval            ! Stencil at each point
+
+   !! * Control permutation of array indices
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
+
+!! DCSE_NEMO: this style defeats ftrans
+!     REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+!        & pval             ! Local 3D array to extract data from
+!     REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+!        & pgval            ! Stencil at each point
+
+!FTRANS pval :I :I :z
+      REAL(KIND=wp), INTENT(IN) ::&
+         & pval(jpi,jpj,kpk)             ! Local 3D array to extract data from
+
+!FTRANS pgval :I :I :z :
+      REAL(KIND=wp), INTENT(OUT) ::&
+         & pgval(kptsi,kptsj,kpk,kobs)   ! Stencil at each point
+
       !! * Local declarations
       REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
@@ -281,5 +323,5 @@
       END DO
 
-      ! Send and recieve buffers for list of points
+      ! Send and receive buffers for list of points
 
       CALL mpp_alltoallv_int( igrdij_send, kptsi*kptsj*kobs*2, nplocal(:)*2, &
@@ -320,5 +362,5 @@
       END DO
 
-      ! Deallocate message parsing workspace
+      ! Deallocate message passing workspace
 
       DEALLOCATE( &
@@ -353,10 +395,24 @@
       INTEGER, INTENT(IN) :: kpk          ! Number of levels
       INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
-         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdi, &         ! i,j indices for each stencil
          & kgrdj
-      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
-         & pval             ! Local 3D array to extract data from
-      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
-         & pgval            ! Stencil at each point
+
+   !! * Control permutation of array indices
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
+
+!! DCSE_NEMO: this style defeats ftrans
+!     REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+!        & pval             ! Local 3D array to extract data from
+!     REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+!        & pgval            ! Stencil at each point
+
+!FTRANS pval :I :I :z
+      REAL(KIND=wp), INTENT(IN)  ::&
+         & pval(jpi,jpj,kpk)             ! Local 3D array to extract data from
+!FTRANS pgval :I :I :z :
+      REAL(KIND=wp), INTENT(OUT) ::&
+         & pgval(kptsi,kptsj,kpk,kobs)   ! Stencil at each point
+
       !! * Local declarations
       INTEGER ::  ji
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 3211)
@@ -55,4 +55,7 @@
    INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types
 
+   !! * Control permutation of array indices
+   !! None required from dom_oce_ftrans.h90
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -133,8 +136,15 @@
       INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
       INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
-      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
-         & ptn,    &    ! Model temperature field
-         & psn,    &    ! Model salinity field
-         & ptmask       ! Land-sea mask
+!! DCSE_NEMO : this style defeats ftrans
+!     REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+!        & ptn,    &    ! Model temperature field
+!        & psn,    &    ! Model salinity field
+!        & ptmask       ! Land-sea mask
+
+!FTRANS ptn psn ptmask :I :I :z
+      REAL(KIND=wp), INTENT(IN) :: ptn(kpi,kpj,kpk)    ! Model temperature field
+      REAL(KIND=wp), INTENT(IN) :: psn(kpi,kpj,kpk)    ! Model salinity field
+      REAL(KIND=wp), INTENT(IN) :: ptmask(kpi,kpj,kpk) ! Land-sea mask
+
       REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
          & pgdept       ! Model array of depth levels
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 3211)
@@ -42,4 +42,7 @@
       & obs_pre_vel, &     ! First level check and screening of velocity profiles
       & calc_month_len     ! Calculate the number of days in the months of a year  
+
+   !! * Control permutation of array indices
+   !! No arrays with indices to permute.
 
    !!----------------------------------------------------------------------
@@ -356,4 +359,12 @@
       USE domstp              ! Domain: set the time-step
       USE par_oce             ! Ocean parameters
+#if defined key_z_first
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & tmask_1, &
+         & nproc
+#else
       USE dom_oce, ONLY : &   ! Geographical information
          & glamt,   &
@@ -361,4 +372,9 @@
          & tmask,   &
          & nproc
+#endif
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
       !! * Arguments
       TYPE(obs_surf), INTENT(INOUT) :: sladata    ! Full set of SLA data
@@ -440,5 +456,9 @@
          &                 sladata%rlam, sladata%rphi, &
          &                 glamt,        gphit,        &
+#if defined key_z_first
+         &                 tmask_1(:,:), sladata%nqc,  &
+#else
          &                 tmask(:,:,1), sladata%nqc,  &
+#endif
          &                 iosdsobs,     ilansobs,     &
          &                 inlasobs,     ld_nea        )
@@ -526,4 +546,8 @@
    END SUBROUTINE obs_pre_sla
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+   !! No arrays with indices to permute.
+
    SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea )
       !!----------------------------------------------------------------------
@@ -544,4 +568,12 @@
       USE domstp              ! Domain: set the time-step
       USE par_oce             ! Ocean parameters
+#if defined key_z_first
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & tmask_1, &
+         & nproc
+#else
       USE dom_oce, ONLY : &   ! Geographical information
          & glamt,   &
@@ -549,4 +581,9 @@
          & tmask,   &
          & nproc
+#endif
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
       !! * Arguments
       TYPE(obs_surf), INTENT(INOUT) :: sstdata     ! Full set of SST data
@@ -625,5 +662,9 @@
          &                 sstdata%rlam, sstdata%rphi, &
          &                 glamt,        gphit,        &
+#if defined key_z_first
+         &                 tmask_1(:,:), sstdata%nqc,  &
+#else
          &                 tmask(:,:,1), sstdata%nqc,  &
+#endif
          &                 iosdsobs,     ilansobs,     &
          &                 inlasobs,     ld_nea        )
@@ -711,4 +752,8 @@
    END SUBROUTINE obs_pre_sst
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+   !! No arrays with indices to permute.
+
    SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea )
       !!----------------------------------------------------------------------
@@ -733,5 +778,12 @@
          & gphit,   &
          & tmask,   &
+#if defined key_z_first
+         & tmask_1, &
+#endif
          & nproc
+
+      !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
       !! * Arguments
       TYPE(obs_surf), INTENT(INOUT) :: seaicedata     ! Full set of Sea Ice data
@@ -810,5 +862,9 @@
          &                 seaicedata%rlam, seaicedata%rphi, &
          &                 glamt,           gphit,           &
+#if defined key_z_first
+         &                 tmask_1(:,:),    seaicedata%nqc,  &
+#else
          &                 tmask(:,:,1),    seaicedata%nqc,  &
+#endif
          &                 iosdsobs,        ilansobs,        &
          &                 inlasobs,        ld_nea           )
@@ -896,4 +952,8 @@
    END SUBROUTINE obs_pre_seaice
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+   !! No arrays with indices to permute.
+
    SUBROUTINE obs_pre_vel( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav )
       !!----------------------------------------------------------------------
@@ -919,4 +979,8 @@
          & tmask, umask, vmask,  &
          & nproc
+
+      !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
       !! * Arguments
       TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data
@@ -1188,4 +1252,8 @@
    END SUBROUTINE obs_pre_vel
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+   !! No arrays with indices to permute.
+
    SUBROUTINE obs_coo_tim( kcycle, &
       &                    kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
@@ -1710,4 +1778,7 @@
       USE dom_oce, ONLY : &       ! Geographical information
          & gdepw_0                        
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
       !! * Arguments
@@ -1868,4 +1939,8 @@
    END SUBROUTINE obs_coo_spc_3d
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+   !! No arrays with indices to permute.
+
    SUBROUTINE obs_pro_rej( profdata )
       !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 3211)
@@ -24,4 +24,7 @@
    USE dom_oce, ONLY : &        ! Domain variables
       & tmask, &
+#if defined key_z_first
+      & tmask_1, &
+#endif
       & tmask_i, &
       & e1t,   &
@@ -40,4 +43,7 @@
 
    PUBLIC obs_rea_altbias     ! Read the altimeter bias
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -175,6 +181,11 @@
          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
             &                  igrdi, igrdj, gphit, zgphi )
+#if defined key_z_first
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, tmask_1(:,:), zmask )
+#else
          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
             &                  igrdi, igrdj, tmask(:,:,1), zmask )
+#endif
          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
             &                  igrdi, igrdj, z_altbias, zbias )
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 3211)
@@ -34,4 +34,7 @@
 
    PUBLIC obs_rea_pro_dri  ! Read the profile observations 
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90	(revision 3211)
@@ -32,4 +32,7 @@
    PUBLIC obs_rea_seaice      ! Read the seaice observations from the point data
    
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90	(revision 3211)
@@ -31,4 +31,7 @@
 
    PUBLIC obs_rea_sla  ! Read the SLA observations from the AVISO/SLA database
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90	(revision 3211)
@@ -33,4 +33,7 @@
    PUBLIC obs_rea_sst      ! Read the SST observations from the point data
    PUBLIC obs_rea_sst_rey  ! Read the gridded Reynolds SST 
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
    
    !!----------------------------------------------------------------------
@@ -694,5 +697,9 @@
       DO jj = nldj, nlej
          DO ji = nldi, nlei
+#if defined key_z_first
+            IF ( tmask_1(ji,jj) == 1.0_wp ) inumobs = inumobs + 1
+#else
             IF ( tmask(ji,jj,1) == 1.0_wp ) inumobs = inumobs + 1
+#endif
          END DO
       END DO
@@ -717,5 +724,9 @@
             DO ji = nldi, nlei
 
+#if defined key_z_first
+               IF ( tmask_1(ji,jj) == 1.0_wp ) THEN
+#else
                IF ( tmask(ji,jj,1) == 1.0_wp ) THEN
+#endif
 
                   inumobs = inumobs + 1
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90	(revision 3211)
@@ -34,4 +34,7 @@
 
    PUBLIC obs_rea_vel_dri  ! Read the profile observations 
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 3211)
@@ -37,4 +37,7 @@
    REAL(wp), PUBLIC ::   mdtcutoff = 65.0_wp   ! MDT cutoff for computed correction
 
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -106,5 +109,9 @@
       ! setup mask based on tmask and MDT mask
       ! set mask to 0 where the MDT is set to fillvalue
+#if defined key_z_first
+      WHERE(z_mdt(:,:) /= zfill)   ;   mdtmask(:,:) = tmask_1(:,:)
+#else
       WHERE(z_mdt(:,:) /= zfill)   ;   mdtmask(:,:) = tmask(:,:,1)
+#endif
       ELSE WHERE                   ;   mdtmask(:,:) = 0
       END WHERE
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 3211)
@@ -27,4 +27,7 @@
 
    PUBLIC obs_rotvel            ! Rotate the observations
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
@@ -148,6 +151,11 @@
       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
          &                  gphiu, zgphiu )
+#if defined key_z_first
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  umask_1(:,:), zmasku )
+#else
       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
          &                  umask(:,:,1), zmasku )
+#endif
       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
          &                  zsingu, zsinlu )
@@ -158,6 +166,11 @@
       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
          &                  gphiv, zgphiv )
+#if defined key_z_first
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  vmask_1(:,:), zmaskv )
+#else
       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
          &                  vmask(:,:,1), zmaskv )
+#endif
       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
          &                  zsingv, zsinlv )
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 3211)
@@ -51,4 +51,7 @@
       CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: cdunit
    END TYPE obswriinfo
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 3211)
@@ -63,4 +63,7 @@
 
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90	(revision 3211)
@@ -65,4 +65,7 @@
    TYPE(PRISM_Time_struct), PUBLIC    :: date            ! date info for send operation
    TYPE(PRISM_Time_struct), PUBLIC    :: date_bound(2)   ! date info for send operation
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 3211)
@@ -90,4 +90,8 @@
 
    PUBLIC   fld_read, fld_fill   ! called by sbc... modules
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 3211)
@@ -40,4 +40,7 @@
 
    LOGICAL ::   lmust_init = .TRUE.        !: used to initialize the cos/sin variables (se above)
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 3211)
@@ -49,26 +49,27 @@
    LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
    !!                                   !!   now    ! before   !!
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau, utau_b  !: sea surface i-stress (ocean referential)  [N/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau, vtau_b  !: sea surface j-stress (ocean referential)  [N/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum          !: module of sea surface stress (at T-point) [N/m2] 
    !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm          !: wind speed module at T-point (=|U10m-Uoce|) [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr           !: sea heat flux:     solar                   [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns,  qns_b   !: sea heat flux: non solar                   [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot       !: total    solar heat flux (over sea and ice) [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot       !: total non solar heat flux (over sea and ice) [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp,  emp_b   !: freshwater budget: volume flux           [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emps, emps_b  !: freshwater budget: concentration/dilution [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot       !: total E-P over ocean and ice              [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf, rnf_b    !: river runoff   [Kg/m2/s]  
    !!
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend [K.m/s] jpi,jpj,jpts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux [K.m/s]
+   !                                                                             ! jpi,jpj,jpk
    !!
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip           !: total precipitation                          [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip       !: total precipitation                       [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip       !: solid precipitation                       [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i          !: ice fraction = 1 - lead fraction  (between 0 to 1)
 #if defined key_cpl_carbon_cycle
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2       !: atmospheric pCO2                          [ppm]
 #endif
 
@@ -77,9 +78,14 @@
    !!----------------------------------------------------------------------
    INTEGER , PUBLIC                     ::   nn_fsbc   !: frequency of sbc computation (as well as sea-ice model)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssu_m     !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssv_m     !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sst_m     !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssu_m   !: mean (nn_fsbc time-step) surface sea i-current (U-point)
+   !                                                                !                                                 [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssv_m   !: mean (nn_fsbc time-step) surface sea j-current (V-point)
+   !                                                                !                                                 [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sst_m   !: mean (nn_fsbc time-step) surface sea temp      [Celsius]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m   !: mean (nn_fsbc time-step) surface sea salinity  [psu]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m   !: mean (nn_fsbc time-step) sea surface height    [m]
+
+   !! * Control permutation of array indices
+#  include "sbc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -134,4 +140,8 @@
       !!---------------------------------------------------------------------
       USE dom_oce         ! ocean space and time domain
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
       USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
       REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
@@ -148,5 +158,9 @@
             zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
             ztau = SQRT( ztx * ztx + zty * zty )
+#if defined key_z_first
+            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask_1(ji,jj)
+#else
             wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
+#endif
          END DO
       END DO
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce_ftrans.h90	(revision 3211)
@@ -0,0 +1,21 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  sbc_oce_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices for
+   !!   public multi-dimensional arrays with a z-dimension declared in module
+   !!   sbc_oce.  It should be included wherever the module is used,
+   !!   and updated whenever a new, public array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS qsr_hc   :I :I :z
+!FTRANS qsr_hc_b :I :I :z
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 3211)
@@ -35,5 +35,10 @@
    REAL(wp) ::   rn_qsr0   = 0._wp   !     solar heat flux
    REAL(wp) ::   rn_emp0   = 0._wp   ! net freshwater flux
-   
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -210,5 +215,9 @@
       IF( nbench /= 1 ) THEN
          zsumemp = GLOB_SUM( emp(:,:) ) 
+#if defined key_z_first
+         zsurf   = GLOB_SUM( tmask_1(:,:) ) 
+#else
          zsurf   = GLOB_SUM( tmask(:,:,1) ) 
+#endif
          ! Default GYRE configuration
          zsumemp = zsumemp / zsurf
@@ -219,5 +228,9 @@
 
       !salinity terms
+#if defined key_z_first
+      emp (:,:) = emp(:,:) - zsumemp * tmask_1(:,:)
+#else
       emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)
+#endif
       emps(:,:) = emp(:,:)
 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 3211)
@@ -42,4 +42,9 @@
    
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 3211)
@@ -79,4 +79,9 @@
    REAL(wp) ::   eps20  = 1.e-20   ! constant values
    
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -308,5 +313,9 @@
             !--------------------------------------------------
             !                                                          ! vapour pressure at saturation of ocean
+#if defined key_z_first
+            zeso =  611.0 * EXP ( 17.2693884 * ( zsst - rtt ) * tmask_1(ji,jj) / ( zsst - 35.86 ) )
+#else
             zeso =  611.0 * EXP ( 17.2693884 * ( zsst - rtt ) * tmask(ji,jj,1) / ( zsst - 35.86 ) )
+#endif
 
             zqsato = ( 0.622 * zeso ) / ( zpatm - 0.378 * zeso )       ! humidity close to the ocean surface (at saturation)
@@ -369,5 +378,9 @@
 
 !CDIR COLLAPSE
+#if defined key_z_first
+      emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask_1(:,:)
+#else
       emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1)
+#endif
       qns (:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)         ! Downward Non Solar flux
       emps(:,:) = emp(:,:)
@@ -560,5 +573,9 @@
 
                ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential)
+#if defined key_z_first
+               zesi =  611.0 * EXP( 21.8745587 * tmask_1(ji,jj) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )
+#else
                zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )
+#endif
                ! humidity close to the ice surface (at saturation)
                zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi )
@@ -619,8 +636,15 @@
 !!gm : mask is not required on forcing
       DO jl = 1, ijpl
+#if defined key_z_first
+         p_qns (:,:,jl) = p_qns (:,:,jl) * tmask_1(:,:)
+         p_qla (:,:,jl) = p_qla (:,:,jl) * tmask_1(:,:)
+         p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask_1(:,:)
+         p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask_1(:,:)
+#else
          p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1)
          p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1)
          p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1)
          p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1)
+#endif
       END DO
 
@@ -787,5 +811,9 @@
             zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj,1)   &     ! cloud correction (Reed 1977)
                &                          + 0.0019 * zlmunoon )                 )
+#if defined key_z_first
+            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask_1(ji,jj)    ! and zcoef1: ellipsity
+#else
             pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)    ! and zcoef1: ellipsity
+#endif
          END DO
       END DO
@@ -925,5 +953,9 @@
          !
          ! Correction : Taking into account the ellipsity of the earth orbit
+#if defined key_z_first
+         pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * zcoef1 * tmask_1(:,:)
+#else
          pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * zcoef1 * tmask(:,:,1)
+#endif
          !
          !                 !--------------------------------! 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 3211)
@@ -70,4 +70,9 @@
    LOGICAL  ::   ln_taudif = .FALSE.   ! logical flag to use the "mean of stress module - module of mean stress" data
    REAL(wp) ::   rn_pfac   = 1.        ! multiplication factor for precipitation
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -261,6 +266,11 @@
 !CDIR NOVERRCHK
 !CDIR COLLAPSE
+#if defined key_z_first
+      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
+         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask_1(:,:)
+#else
       wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
          &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
+#endif
 
       ! ----------------------------------------------------------------------------- !
@@ -270,9 +280,18 @@
       ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
       zztmp = 1. - albo
+#if defined key_z_first
+      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask_1(:,:)
+      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask_1(:,:)
+#else
       IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
       ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
-      ENDIF
-!CDIR COLLAPSE
+#endif
+      ENDIF
+!CDIR COLLAPSE
+#if defined key_z_first
+      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask_1(:,:)   ! Long  Wave
+#else
       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
+#endif
       ! ----------------------------------------------------------------------------- !
       !     II    Turbulent FLUXES                                                    !
@@ -366,5 +385,9 @@
       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux
 !CDIR COLLAPSE
+#if defined key_z_first
+      emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask_1(:,:)
+#else
       emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)
+#endif
 !CDIR COLLAPSE
       emps(:,:) = emp(:,:)
@@ -495,5 +518,9 @@
                zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   &
                   &                                          + pvi(ji,jj  ) + pvi(ji+1,jj  )  )
+#if defined key_z_first
+               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask_1(ji,jj)
+#else
                z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+#endif
             END DO
          END DO
@@ -510,5 +537,9 @@
                zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  )
                zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  )
+#if defined key_z_first
+               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask_1(ji,jj)
+#else
                z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+#endif
             END DO
          END DO
@@ -547,5 +578,9 @@
                p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
                ! Long  Wave (lw)
+#if defined key_z_first
+               z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3  ) * tmask_1(ji,jj)
+#else
                z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1)
+#endif
                ! lw sensitivity
                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                               
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 3211)
@@ -162,4 +162,9 @@
 #endif
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+
    !! Substitution
 #  include "vectopt_loop_substitute.h90"
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 3211)
@@ -28,4 +28,9 @@
   
    PUBLIC   sbc_dcy        ! routine called by sbc
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 3211)
@@ -35,4 +35,9 @@
    INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 3211)
@@ -34,4 +34,9 @@
    REAL(wp) ::   fwfold    ! fwfold to be suppressed
    REAL(wp) ::   area      ! global mean ocean surface (interior domain)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 3211)
@@ -27,4 +27,9 @@
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ice   ! structure of input ice-cover (file informations, fields read)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
    
    !! * Substitutions
@@ -96,5 +101,9 @@
                                  ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 )
          
+#if defined key_z_first
+         fr_i(:,:) = tfreez( sss_m ) * tmask_1(:,:)       ! sea surface freezing temperature [Celcius]
+#else
          fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius]
+#endif
 
          ! Flux and ice fraction computation
@@ -119,6 +128,11 @@
                zqri = ztrp * ( tb(ji,jj,1) - ( zt_fzp - 1.) )
                zqrj = ztrp * MIN( 0., tb(ji,jj,1) - zt_fzp )
+#if defined key_z_first
+               zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    &
+                 &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask_1(ji,jj)
+#else
                zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    &
                  &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1)
+#endif
 
                !                                            ! non-solar heat flux 
@@ -128,7 +142,13 @@
                !                                   (-2=arctic, -4=antarctic)   
                zqi = -3. + SIGN( 1.e0, ff(ji,jj) )
+#if defined key_z_first
+               qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj)                             &
+                  &          +      zfr_obs   * fr_i(ji,jj) * zqi ) * tmask_1(ji,jj)    &
+                  &       + zqrp
+#else
                qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj)                             &
                   &          +      zfr_obs   * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1)   &
                   &       + zqrp
+#endif
             END DO
          END DO
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 3211)
@@ -58,4 +58,9 @@
 
    PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
    
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 3211)
@@ -53,4 +53,9 @@
    PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -99,4 +104,8 @@
          CALL ctl_stop('sbc_ice_lim_2: requested workspace arrays are unavailable')   ;   RETURN
       ENDIF
+
+
+      !! DCSE_NEMO: Attention! This usage will break index re-ordering !!
+
       ! Use pointers to access only sub-arrays of workspaces
       zalb_ice_os => wrk_3d_1(:,:,1:1)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 3211)
@@ -54,4 +54,9 @@
    
    INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
       
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 3211)
@@ -54,11 +54,16 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf               !: depth of runoff in m
    INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nk_rnf              !: depth of runoff in model levels
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents
+   !                                                                              !            [K.m/s & PSU.m/s]
    
    REAL(wp) ::   r1_rau0   ! = 1 / rau0 
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)  
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file info, fields read)  
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file info, fields read)  
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
  
    !! * Substitutions  
@@ -197,4 +202,5 @@
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
+!FTRANS phdivn :I :I :z
       !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -238,4 +244,7 @@
    END SUBROUTINE sbc_rnf_div
 
+   !! * Reset control of array index permutation
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    SUBROUTINE sbc_rnf_init
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 3211)
@@ -14,5 +14,4 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_oce         ! surface boundary condition: ocean fields
    USE sbcapr          ! surface boundary condition: atmospheric pressure
@@ -26,4 +25,9 @@
 
    PUBLIC   sbc_ssm    ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
    
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 3211)
@@ -41,4 +41,9 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sst   ! structure of input SST (file informations, fields read)
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90	(revision 3211)
@@ -37,4 +37,9 @@
    PUBLIC   sol_mat    ! routine called by inisol.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -207,5 +212,9 @@
                !  south coefficient
                IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN
+#if defined key_z_first
+                  zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask_1(ji,jj-1))
+#else
                   zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1))
+#endif
                ELSE
                   zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)
@@ -223,5 +232,9 @@
                !   east coefficient
                IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN
+#if defined key_z_first
+                  zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-umask_1(ji,jj))
+#else
                   zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1))
+#endif
                ELSE
                   zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)
@@ -231,5 +244,9 @@
                !   north coefficient
                IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN
+#if defined key_z_first
+                  zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vmask_1(ji,jj))
+#else
                   zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1))
+#endif
                ELSE
                   zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 3211)
@@ -20,4 +20,8 @@
 
    PUBLIC   sol_pcg    ! 
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90	(revision 3211)
@@ -28,4 +28,9 @@
 
    PUBLIC   sol_sor    ! 
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 3211)
@@ -29,4 +29,10 @@
 
    IMPLICIT NONE
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 3211)
@@ -61,4 +61,8 @@
 
    REAL(wp), PUBLIC ::   ralpbet              !: alpha / beta ratio
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
    
    !! * Substitutions
@@ -111,4 +115,9 @@
       USE wrk_nemo, ONLY:   zws => wrk_3d_1   ! 3D workspace
       !!
+
+!FTRANS zws :I :I :z
+!FTRANS pts :I :I :z :I
+!FTRANS prd :I :I :z
+
       REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
       !                                                      ! 2 : salinity               [psu]
@@ -135,7 +144,13 @@
          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
          !  
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zt = pts   (ji,jj,jk,jp_tem)
                   zs = pts   (ji,jj,jk,jp_sal)
@@ -178,12 +193,32 @@
          !
       CASE( 1 )                !==  Linear formulation function of temperature only  ==!
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  prd(ji,jj,jk) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jk,jp_tem) ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
          END DO
+#endif
          !
       CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==!
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  prd(ji,jj,jk) = ( rn_beta  * pts(ji,jj,jk,jp_sal) - rn_alpha * pts(ji,jj,jk,jp_tem) ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
          END DO
+#endif
          !
       END SELECT
@@ -193,4 +228,10 @@
       IF( wrk_not_released(3, 1) )   CALL ctl_stop('eos_insitu: failed to release workspace array')
       !
+
+!! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+
    END SUBROUTINE eos_insitu
 
@@ -245,8 +286,19 @@
       USE wrk_nemo, ONLY:   zws => wrk_3d_1 ! 3D workspace
       !!
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius]
-      !                                                                ! 2 : salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-]
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+
+!FTRANS zws :I :I :z
+!FTRANS pts :I :I :z :I
+!FTRANS prd :I :I :z
+!FTRANS prhop :I :I :z
+
+!!DCSE NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius]
+!     !                                                                ! 2 : salinity               [psu]
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-]
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      REAL(wp), INTENT(in   ) ::   pts(jpi,jpj,jpk,jpts)   ! 1 : potential temperature  [Celcius]
+      !                                                    ! 2 : salinity               [psu]
+      REAL(wp), INTENT(  out) ::   prd(jpi,jpj,jpk)        ! in situ density            [-]
+      REAL(wp), INTENT(  out) ::   prhop(jpi,jpj,jpk)      ! potential density (surface referenced)
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -266,7 +318,13 @@
          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
          !  
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zt = pts   (ji,jj,jk,jp_tem)
                   zs = pts   (ji,jj,jk,jp_sal)
@@ -312,14 +370,36 @@
          !
       CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  prd  (ji,jj,jk) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jk,jp_tem) )        * tmask(ji,jj,jk)
+                  prhop(ji,jj,jk) = ( 1.e0_wp   +            prd(ji,jj,jk)        ) * rau0 * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk)
             prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask(:,:,jk)
          END DO
+#endif
          !
       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  prd  (ji,jj,jk) = ( rn_beta  * pts(ji,jj,jk,jp_sal) - rn_alpha * pts(ji,jj,jk,jp_tem) )        * tmask(ji,jj,jk)
+                  prhop(ji,jj,jk) = ( 1.e0_wp  + prd(ji,jj,jk)                                          ) * rau0 * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk)
             prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask(:,:,jk)
          END DO
+#endif
          !
       END SELECT
@@ -329,4 +409,10 @@
       IF( wrk_not_released(3, 1) )   CALL ctl_stop('eos_insitu_pot: failed to release workspace array')
       !
+
+!! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+
    END SUBROUTINE eos_insitu_pot
 
@@ -400,5 +486,9 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
+#if defined key_z_first
+               zmask = tmask_1(ji,jj)          ! land/sea bottom mask = surf. mask
+#else
                zmask = tmask(ji,jj,1)          ! land/sea bottom mask = surf. mask
+#endif
                zt    = pts  (ji,jj,jp_tem)            ! interpolated T
                zs    = pts  (ji,jj,jp_sal)            ! interpolated S
@@ -442,5 +532,9 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
+#if defined key_z_first
+               prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_1(ji,jj)
+#else
                prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)
+#endif
             END DO
          END DO
@@ -449,5 +543,9 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
+#if defined key_z_first
+               prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_1(ji,jj) 
+#else
                prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 
+#endif
             END DO
          END DO
@@ -492,7 +590,16 @@
       !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987.
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
-      !                                                               ! 2 : salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1]
+
+!FTRANS pts :I :I :z :I
+!FTRANS pn2 :I :I :z
+
+!!DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+!     !                                                               ! 2 : salinity               [psu]
+!     REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1]
+
+      REAL(wp), INTENT(in   ) ::   pts(jpi,jpj,jpk,jpts)   ! 1 : potential temperature  [Celcius]
+      !                                                    ! 2 : salinity               [psu]
+      REAL(wp), INTENT(  out) ::   pn2(jpi,jpj,jpk)        ! Brunt-Vaisala frequency    [s-1]
       !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -509,7 +616,13 @@
       !
       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zgde3w = grav / fse3w(ji,jj,jk)
                   zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )         ! potential temperature at w-pt
@@ -556,9 +669,31 @@
          !
       CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1
+                  pn2(ji,jj,jk) = grav * rn_alpha * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) &
+                     &                 / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 2, jpkm1
             pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)
          END DO
+#endif
          !
       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1
+                  pn2(ji,jj,jk) = grav * (  rn_alpha * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )      &
+                     &                    - rn_beta  * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )   &
+                     &                 / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO 
+#else
          DO jk = 2, jpkm1
             pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      &
@@ -566,8 +701,15 @@
                &               / fse3w(:,:,jk) * tmask(:,:,jk)
          END DO 
+#endif
 #if defined key_zdfddm
+#if defined key_z_first
+         DO jj = 1, jpj                                   ! Rrau = (alpha / beta) (dk[t] / dk[s])
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s])
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  
                   IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp
@@ -584,4 +726,10 @@
 #endif
       !
+
+!! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+
    END SUBROUTINE eos_bn2
 
@@ -609,6 +757,14 @@
       !! ** Action  : - palph, pbeta : thermal and haline expansion coeff. at T-point
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts            ! pot. temperature & salinity
-      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palph, pbeta   ! thermal & haline expansion coeff.
+
+!FTRANS pts :I :I :z :I
+!FTRANS palph :I :I :z
+!FTRANS pbeta :I :I :z
+!!DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts            ! pot. temperature & salinity
+!     REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palph, pbeta   ! thermal & haline expansion coeff.
+      REAL(wp), INTENT(in   ) ::   pts(jpi,jpj,jpk,jpts)            ! pot. temperature & salinity
+      REAL(wp), INTENT(  out) ::   palph(jpi,jpj,jpk)               ! thermal expansion coeff.
+      REAL(wp), INTENT(  out) ::   pbeta(jpi,jpj,jpk)               ! haline  expansion coeff.
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -619,7 +775,13 @@
       !
       CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+#else
          DO jk = 1, jpk
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zt = pts(ji,jj,jk,jp_tem)           ! potential temperature
                   zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35)
@@ -670,4 +832,10 @@
       END SELECT
       !
+
+!! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+
    END SUBROUTINE eos_alpbet
 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 3211)
@@ -44,4 +44,9 @@
    INTEGER ::   nadv   ! choice of the type of advection scheme
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -64,8 +69,12 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   zun => wrk_3d_1 , zvn => wrk_3d_2 , zwn => wrk_3d_3   ! 3D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zun zvn zwn :I :I :z
+
       !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !
-      INTEGER ::   jk   ! dummy loop index
+      INTEGER ::   ji, jj, jk   ! dummy loop index
       !!----------------------------------------------------------------------
       !
@@ -83,4 +92,18 @@
       !
       !                                               !==  effective transport  ==!
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               zun(ji,jj,jk) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk)     ! eulerian transport only
+               zvn(ji,jj,jk) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk)
+               zwn(ji,jj,jk) = e1t(ji,jj) * e2t(ji,jj)      * wn(ji,jj,jk)
+            END DO
+            zun(ji,jj,jpk) = 0._wp                                             ! no transport trough the bottom
+            zvn(ji,jj,jpk) = 0._wp                                             ! no transport trough the bottom
+            zwn(ji,jj,jpk) = 0._wp                                             ! no transport trough the bottom
+         END DO
+      END DO
+#else
       DO jk = 1, jpkm1
          zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only
@@ -91,4 +114,5 @@
       zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
       zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
+#endif
       !
       IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 3211)
@@ -43,4 +43,11 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 
    !                                                             !  and in closed seas (orca 2 and 4 configurations)
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -114,11 +121,24 @@
       USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zind => wrk_3d_2   ! 3D workspace
       USE wrk_nemo, ONLY:   ztfreez => wrk_2d_1                  ! 2D     -
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwx zwy zwz zind :I :I :z
       !
       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+!FTRANS pun pvn pwn :I :I :z
+      REAL(wp), INTENT(in   ) ::   pun(jpi,jpj,jpk)         ! ocean velocity component
+      REAL(wp), INTENT(in   ) ::   pvn(jpi,jpj,jpk)         ! ocean velocity component
+      REAL(wp), INTENT(in   ) ::   pwn(jpi,jpj,jpk)         ! ocean velocity component
+!FTRANS ptb ptn pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)    ! tracer field (before)
+      REAL(wp), INTENT(in   ) ::   ptn(jpi,jpj,jpk,kjpt)    ! tracer field (now)
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)    ! tracer trend 
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -164,7 +184,13 @@
 !!gm  not a big deal since cen2 is no more used in global ice-ocean simulations
       ztfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) )
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                !                                        ! below ice covered area (if tn < "freezing"+0.1 )
                IF( tsn(ji,jj,jk,jp_tem) <= ztfreez(ji,jj) + 0.1 ) THEN   ;   zice = 1.e0
@@ -185,4 +211,9 @@
          !    ====================
          !
+#if defined key_z_first
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             !                        ! Second order centered tracer flux at u- and v-points
@@ -190,4 +221,5 @@
                !
                DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                   ! upstream indicator
                   zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
@@ -221,7 +253,13 @@
          ENDIF
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               DO jk = 2, jpk
+#else
          DO jk = 2, jpk              ! Second order centered tracer flux at w-point
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ! upstream indicator
                   zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) 
@@ -240,7 +278,13 @@
          ! II. Divergence of advective fluxes
          ! ----------------------------------
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) *  fse3t(ji,jj,jk) )
                   ! advective trends
@@ -278,4 +322,12 @@
           wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_cen2: failed to release workspace arrays')
       !
+
+!! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+
    END SUBROUTINE tra_adv_cen2
    
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 3211)
@@ -32,4 +32,11 @@
 
    PUBLIC   tra_adv_eiv   ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
 
    !! * Substitutions
@@ -70,7 +77,14 @@
       INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index
       CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean velocity components 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean velocity components 
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean velocity components
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv
+
+!FTRANS pun pvn pwn :I :I :z
+      REAL(wp), INTENT(inout) ::   pun(jpi,jpj,jpk)      ! in : 3 ocean velocity components 
+      REAL(wp), INTENT(inout) ::   pvn(jpi,jpj,jpk)      ! out: 3 ocean velocity components
+      REAL(wp), INTENT(inout) ::   pwn(jpi,jpj,jpk)      ! increased by the eiv
       !!
       INTEGER  ::   ji, jj, jk                 ! dummy loop indices
@@ -105,4 +119,5 @@
       zu_eiv(:,:) = 0.e0   ;   zv_eiv(:,:) = 0.e0   ;    zw_eiv(:,:) = 0.e0  
       
+!!DCSE_NEMO: TODO - restucture loop(s) so that loop over levels is innermost
                                                     ! =================
       DO jk = 1, jpkm1                              !  Horizontal slab
@@ -165,7 +180,13 @@
             zztmp = 0.5 * rau0 * rcp 
             z2d(:,:) = 0.e0 
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) &
                        &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e1u(ji,jj) * fse3u(ji,jj,jk) 
@@ -176,7 +197,13 @@
             CALL iom_put( "ueiv_heattr", z2d )                  ! heat transport in i-direction
             z2d(:,:) = 0.e0 
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) &
                      &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e2v(ji,jj) * fse3v(ji,jj,jk) 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 3211)
@@ -33,4 +33,9 @@
 
    LOGICAL  :: l_trd       ! flag to compute trends
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -64,4 +69,8 @@
       USE oce     , ONLY:   zwx   => ua       , zwy   => va          ! (ua,va) used as workspace
       USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2    ! 3D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwx zwy zslpx zslpy :I :I :z
+
       !
       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
@@ -69,7 +78,19 @@
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+!FTRANS pun pvn pwn :I :I :z
+!FTRANS ptb :I :I :z :
+!FTRANS pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   pun(jpi,jpj,jpk)        ! ocean velocity component (u)
+      REAL(wp), INTENT(in   ) ::   pvn(jpi,jpj,jpk)        ! ocean velocity component (v)
+      REAL(wp), INTENT(in   ) ::   pwn(jpi,jpj,jpk)        ! ocean velocity component (w)
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)   ! tracer fields (before)
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)   ! tracer trend 
+
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -100,7 +121,13 @@
          zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
          ! interior values
+#if defined key_z_first
+         DO jj = 1, jpjm1      
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpjm1      
                DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                   zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
                   zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
@@ -113,7 +140,13 @@
          !                                             !-- Slopes of tracer
          zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
+#if defined key_z_first
+         DO jj = 2, jpj                                       ! interior values
+            DO ji = 2, jpi
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1                                     ! interior values
             DO jj = 2, jpj
                DO ji = fs_2, jpi   ! vector opt.
+#endif
                   zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
                      &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
@@ -124,7 +157,13 @@
          END DO
          !
+#if defined key_z_first
+         DO jj = 2, jpj                                       ! Slopes limitation
+            DO ji = 2, jpi
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1                                     ! Slopes limitation
             DO jj = 2, jpj
                DO ji = fs_2, jpi   ! vector opt.
+#endif
                   zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
                      &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
@@ -138,8 +177,15 @@
 
          !                                             !-- MUSCL horizontal advective fluxes
+#if defined key_z_first
+         DO jj = 2, jpjm1                                     ! interior values
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+                  zdt  = p2dt(jk)
+#else
          DO jk = 1, jpkm1                                     ! interior values
             zdt  = p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ! MUSCL fluxes
                   z0u = SIGN( 0.5, pun(ji,jj,jk) )
@@ -163,7 +209,13 @@
          !
          ! Tracer flux divergence at t-point added to the general trend
+#if defined key_z_first
+         DO jj = 2, jpjm1      
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1      
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! horizontal advective trends
@@ -189,14 +241,33 @@
          ! -----------------------------
          !                                             !-- first guess of the slopes
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwx(ji,jj,1) = 0.e0                             ! surface boundary conditions
+               DO jk = 2, jpkm1                                ! interior values
+                  zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+               zwx(ji,jj,jpk) = 0.e0                           ! bottom boundary conditions
+            END DO
+         END DO
+#else
          zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
          DO jk = 2, jpkm1                                     ! interior values
             zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
          END DO
+#endif
 
          !                                             !-- Slopes of tracer
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zslpx(ji,jj,1) = 0.e0                          ! surface values
+               DO jk = 2, jpkm1                               ! interior value
+#else
          zslpx(:,:,1) = 0.e0                                  ! surface values
          DO jk = 2, jpkm1                                     ! interior value
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
                      &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
@@ -205,7 +276,13 @@
          END DO
          !                                             !-- Slopes limitation
+#if defined key_z_first
+         DO jj = 1, jpj   
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1                               ! interior values
+#else
          DO jk = 2, jpkm1                                     ! interior values
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
                      &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
@@ -220,8 +297,15 @@
          ENDIF 
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1                                     ! interior values
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+                  zdt  = p2dt(jk)
+#else
          DO jk = 1, jpkm1                                     ! interior values
             zdt  = p2dt(jk)
             DO jj = 2, jpjm1      
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
                   z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
@@ -236,7 +320,13 @@
 
          ! Compute & add the vertical advective trend
+#if defined key_z_first
+         DO jj = 2, jpjm1      
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1      
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! vertical advective trends 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 3211)
@@ -32,4 +32,9 @@
    LOGICAL  :: l_trd       ! flag to compute trends
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -62,4 +67,7 @@
       USE oce     , ONLY:   zwx   => ua       , zwy   => va         ! (ua,va) used as 3D workspace
       USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2   ! 3D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwx zwy zslpx zslpy :I :I :z
+
       !!
       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
@@ -67,7 +75,20 @@
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before & now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before & now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+!FTRANS pun pvn pwn :I :I :z
+!FTRANS ptb ptn :I :I :z :
+!FTRANS pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   pun(jpi,jpj,jpk)        ! ocean velocity component (u)
+      REAL(wp), INTENT(in   ) ::   pvn(jpi,jpj,jpk)        ! ocean velocity component (v)
+      REAL(wp), INTENT(in   ) ::   pwn(jpi,jpj,jpk)        ! ocean velocity component (w)
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)   ! tracer fields (before)
+      REAL(wp), INTENT(in   ) ::   ptn(jpi,jpj,jpk,kjpt)   ! tracer fields (now)
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)   ! tracer trend 
+
       !!
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -98,7 +119,13 @@
          zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
          ! interior values
+#if defined key_z_first
+         DO jj = 1, jpjm1      
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpjm1      
                DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                   zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
                   zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
@@ -111,7 +138,13 @@
          !                                             !-- Slopes of tracer
          zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
+#if defined key_z_first
+         DO jj = 2, jpj                                       ! interior values
+            DO ji = 2, jpi
+               DO jk = 1, jpkm1 
+#else
          DO jk = 1, jpkm1                                     ! interior values
             DO jj = 2, jpj
                DO ji = fs_2, jpi   ! vector opt.
+#endif
                   zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
                      &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
@@ -122,7 +155,13 @@
          END DO
          !
+#if defined key_z_first
+         DO jj = 2, jpj                                       ! Slopes limitation
+            DO ji = 2, jpi
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1                                     ! Slopes limitation
             DO jj = 2, jpj
                DO ji = fs_2, jpi   ! vector opt.
+#endif
                   zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
                      &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
@@ -132,12 +171,19 @@
                      &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
                END DO
-           END DO
+            END DO
          END DO             ! interior values
 
         !                                             !-- MUSCL horizontal advective fluxes
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1                               ! interior values
+                  zdt  = p2dt(jk)
+#else
          DO jk = 1, jpkm1                                     ! interior values
             zdt  = p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ! MUSCL fluxes
                   z0u = SIGN( 0.5, pun(ji,jj,jk) )
@@ -159,7 +205,13 @@
 
          !!  centered scheme at lateral b.C. if off-shore velocity
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   IF( umask(ji,jj,jk) == 0. ) THEN
                      IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
@@ -184,7 +236,13 @@
 
          ! Tracer flux divergence at t-point added to the general trend
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! horizontal advective trends 
@@ -194,5 +252,5 @@
                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
                END DO
-           END DO
+            END DO
          END DO
          !                                 ! trend diagnostics (contribution of upstream fluxes)
@@ -211,14 +269,33 @@
          ! -----------------------------
          !                                             !-- first guess of the slopes
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwx(ji,jj,1) = 0.e0                     ! surface boundary conditions
+               DO jk = 2, jpkm1                        ! interior values
+                  zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+               zwx(ji,jj,jpk) = 0.e0                   ! bottom boundary conditions
+            END DO
+         END DO
+#else
          zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
          DO jk = 2, jpkm1                                     ! interior values
             zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
          END DO
+#endif
 
          !                                             !-- Slopes of tracer
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zslpx(ji,jj,1) = 0.e0                          ! surface values
+               DO jk = 2, jpkm1                               ! interior value
+#else
          zslpx(:,:,1) = 0.e0                                  ! surface values
          DO jk = 2, jpkm1                                     ! interior value
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
                      &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
@@ -227,7 +304,13 @@
          END DO
          !                                             !-- Slopes limitation
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1                               ! interior values
+#else
          DO jk = 2, jpkm1                                     ! interior values
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
                      &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
@@ -242,8 +325,15 @@
          ENDIF
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1                                     ! interior values
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+                  zdt  = p2dt(jk)
+#else
          DO jk = 1, jpkm1                                     ! interior values
             zdt  = p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
                   z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
@@ -257,7 +347,13 @@
          END DO
          !
-         DO jk = 2, jpkm1        ! centered near the bottom
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1         ! centered near the bottom
+#else
+         DO jk = 2, jpkm1               ! centered near the bottom
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   IF( tmask(ji,jj,jk+1) == 0. ) THEN
                      IF( pwn(ji,jj,jk) > 0. ) THEN
@@ -269,7 +365,13 @@
          END DO
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1        ! Compute & add the vertical advective trend
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1        ! Compute & add the vertical advective trend
             DO jj = 2, jpjm1      
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! vertical advective trends 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 3211)
@@ -35,4 +35,9 @@
    REAL(wp) :: r1_6 = 1./ 6.   ! 1/6 ratio
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -85,7 +90,20 @@
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+!FTRANS pun pvn pwn :I :I :z
+!FTRANS ptb ptn :I :I :z :
+!FTRANS pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   pun(jpi,jpj,jpk)        ! ocean velocity component (u)
+      REAL(wp), INTENT(in   ) ::   pvn(jpi,jpj,jpk)        ! ocean velocity component (v)
+      REAL(wp), INTENT(in   ) ::   pwn(jpi,jpj,jpk)        ! ocean velocity component (w)
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)   ! tracer fields (before)
+      REAL(wp), INTENT(in   ) ::   ptn(jpi,jpj,jpk,kjpt)   ! tracer fields (now)
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)   ! tracer trend 
+
       !!----------------------------------------------------------------------
 
@@ -107,4 +125,11 @@
       CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt )
       !
+
+      !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    END SUBROUTINE tra_adv_qck
 
@@ -118,4 +143,8 @@
       USE oce     , ONLY:   zwx => ua       ! ua used as workspace
       USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwx zfu zfc zfd :I :I :z
+
       !
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
@@ -123,7 +152,17 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+!FTRANS pun :I :I :z
+!FTRANS ptb ptn pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   pun(jpi,jpj,jpk)         ! i-velocity component
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)    ! tracer field (before)
+      REAL(wp), INTENT(in   ) ::   ptn(jpi,jpj,jpk,kjpt)    ! tracer field (now)
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)    ! tracer trend 
+
       !!
       INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
@@ -140,9 +179,16 @@
          zfd(:,:,:) = 0.0     ;   zwx(:,:,:) = 0.0     
          !                                                  
+#if defined key_z_first
+         !--- Computation of the upstream and downstream value of the tracer and the mask
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1                                
+#else
          DO jk = 1, jpkm1                                
             !                                             
-            !--- Computation of the ustream and downstream value of the tracer and the mask
+            !--- Computation of the upstream and downstream value of the tracer and the mask
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ! Upstream in the x-direction for the tracer
                   zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)
@@ -158,7 +204,13 @@
          ! ---------------------------
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1                             
+#else
          DO jk = 1, jpkm1                             
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.         
+#endif
                   zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
                   zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T 
@@ -167,8 +219,15 @@
          END DO
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1  
+                  zdt =  p2dt(jk)
+#else
          DO jk = 1, jpkm1  
             zdt =  p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.   
+#endif
                   zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
                   zdx  = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * fse3u(ji,jj,jk)
@@ -187,7 +246,13 @@
          !
          ! Mask at the T-points in the x-direction (mask=0 or mask=1)
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1  
+#else
          DO jk = 1, jpkm1  
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.               
+#endif
                   zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2.
                END DO
@@ -198,8 +263,13 @@
          !
          ! Tracer flux on the x-direction
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1  
+#else
          DO jk = 1, jpkm1  
-            !
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.               
+#endif
                   zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
                   !--- If the second ustream point is a land point
@@ -210,8 +280,16 @@
                END DO
             END DO
+#if defined key_z_first
+         END DO
+         ! Computation of the trend
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
             !
             ! Computation of the trend
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.  
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! horizontal advective trends
@@ -230,4 +308,11 @@
       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_i: failed to release workspace arrays')
       !
+
+      !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    END SUBROUTINE tra_adv_qck_i
 
@@ -241,4 +326,8 @@
       USE oce     , ONLY:   zwy => ua       ! ua used as workspace
       USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwy zfu zfc zfd :I :I :z
+
       !
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
@@ -246,7 +335,17 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+!FTRANS pvn :I :I :z
+!FTRANS ptb ptn pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   pvn(jpi,jpj,jpk)         ! j-velocity component
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)    ! tracer field (before)
+      REAL(wp), INTENT(in   ) ::   ptn(jpi,jpj,jpk,kjpt)    ! tracer field (now)
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)    ! tracer trend 
+
       !!
       INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
@@ -264,4 +363,10 @@
          zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0     
          !                                                  
+#if defined key_z_first
+         !--- Computation of the ustream and downstream value of the tracer and the mask
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1                                
+#else
          DO jk = 1, jpkm1                                
             !                                             
@@ -269,4 +374,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ! Upstream in the x-direction for the tracer
                   zfc(ji,jj,jk) = ptb(ji,jj-1,jk,jn)
@@ -283,7 +389,13 @@
          ! ---------------------------
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1                             
+#else
          DO jk = 1, jpkm1                             
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.         
+#endif
                   zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
                   zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T 
@@ -292,8 +404,15 @@
          END DO
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1  
+                  zdt =  p2dt(jk)
+#else
          DO jk = 1, jpkm1  
             zdt =  p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.   
+#endif
                   zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
                   zdx  = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * fse3v(ji,jj,jk)
@@ -313,7 +432,13 @@
          !
          ! Mask at the T-points in the x-direction (mask=0 or mask=1)
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1  
+#else
          DO jk = 1, jpkm1  
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.               
+#endif
                   zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2.
                END DO
@@ -324,8 +449,14 @@
          !
          ! Tracer flux on the x-direction
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1  
+#else
          DO jk = 1, jpkm1  
             !
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.               
+#endif
                   zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
                   !--- If the second ustream point is a land point
@@ -336,8 +467,16 @@
                END DO
             END DO
+#if defined key_z_first
+         END DO
+         ! Computation of the trend
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
             !
             ! Computation of the trend
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.  
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! horizontal advective trends
@@ -361,4 +500,11 @@
       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_j: failed to release workspace arrays')
       !
+
+      !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    END SUBROUTINE tra_adv_qck_j
 
@@ -370,11 +516,24 @@
       !!----------------------------------------------------------------------
       USE oce, ONLY:   zwz => ua   ! ua used as workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwz :I :I :z
+
       !
       INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn      ! vertical velocity 
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn      ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn      ! vertical velocity 
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn      ! tracer fields (now)
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+
+!FTRANS pwn :I :I :z
+!FTRANS ptn pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   pwn(jpi,jpj,jpk)         ! vertical velocity
+      REAL(wp), INTENT(in   ) ::   ptn(jpi,jpj,jpk,kjpt)    ! tracer fields (now)
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)    ! tracer trend 
+
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -393,7 +552,13 @@
          ENDIF
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1            ! Interior point: second order centered tracer flux at w-point
+#else
          DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) )
                END DO
@@ -401,7 +566,13 @@
          END DO
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1    !==  Tracer flux divergence added to the general trend  ==!
+#else
          DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! k- vertical advective trends 
@@ -417,4 +588,11 @@
       END DO
       !
+
+      !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    END SUBROUTINE tra_adv_cen2_k
 
@@ -427,8 +605,18 @@
       !! ** Method :   
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfu   ! second upwind point
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfd   ! first douwning point
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfc   ! the central point (or the first upwind point)
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   puc   ! input as Courant number ; output as flux
+
+      !! DCSE_NEMO: This style defeats ftrans
+
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfu   ! second upwind point
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfd   ! first douwning point
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfc   ! the central point (or the first upwind point)
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   puc   ! input as Courant number ; output as flux
+
+!FTRANS pfu pfd pfc puc :I :I :z
+      REAL(wp), INTENT(in   ) ::   pfu(jpi,jpj,jpk)   ! second upwind point
+      REAL(wp), INTENT(in   ) ::   pfd(jpi,jpj,jpk)   ! first douwning point
+      REAL(wp), INTENT(in   ) ::   pfc(jpi,jpj,jpk)   ! the central point (or the first upwind point)
+      REAL(wp), INTENT(inout) ::   puc(jpi,jpj,jpk)   ! input as Courant number ; output as flux
+
       !!
       INTEGER  ::  ji, jj, jk               ! dummy loop indices 
@@ -437,7 +625,13 @@
       !----------------------------------------------------------------------
 
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                zc     = puc(ji,jj,jk)                         ! Courant number
                zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 3211)
@@ -40,4 +40,9 @@
 
    LOGICAL ::   l_trd   ! flag to compute trends
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -69,4 +74,8 @@
       USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace
       USE wrk_nemo, ONLY:   zwi => wrk_3d_12 , zwz => wrk_3d_13   ! 3D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwx zwy zwi zwz :I :I :z
+
       !
       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
@@ -74,7 +83,19 @@
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+!FTRANS pun pvn pwn :I :I :z
+!FTRANS ptb ptn pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   pun(jpi,jpj,jpk)        ! ocean velocity component (u)
+      REAL(wp), INTENT(in   ) ::   pvn(jpi,jpj,jpk)        ! ocean velocity component (v)
+      REAL(wp), INTENT(in   ) ::   pwn(jpi,jpj,jpk)        ! ocean velocity component (w)
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)   ! tracer fields (before)
+      REAL(wp), INTENT(in   ) ::   ptn(jpi,jpj,jpk,kjpt)   ! tracer fields (now)
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)   ! tracer trend 
+
       !
       INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
@@ -83,4 +104,6 @@
       REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
       REAL(wp), DIMENSION (:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz
+!FTRANS ztrdx ztrdy ztrdz :I :I :z
+
       !!----------------------------------------------------------------------
 
@@ -117,7 +140,13 @@
          ! --------------------------------------------------------------------
          ! upstream tracer flux in the i and j direction
+#if defined key_z_first
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                   ! upstream scheme
                   zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
@@ -137,7 +166,13 @@
          ENDIF
          ! Interior value
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
@@ -148,8 +183,15 @@
 
          ! total advective trend
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+                  z2dtt = p2dt(jk)
+#else
          DO jk = 1, jpkm1
             z2dtt = p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! total intermediate advective trends
@@ -180,7 +222,13 @@
          ! --------------------------------------------------
          ! antidiffusive flux on i and j
+#if defined key_z_first
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                   zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
                   zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
@@ -190,9 +238,16 @@
       
          ! antidiffusive flux on k
-         zwz(:,:,1) = 0.e0         ! Surface value
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwz(ji,jj,1) = 0.e0   ! Surface value
+               DO jk = 2, jpkm1
+#else
+         zwz(:,:,1) = 0.e0           ! Surface value
          !
-         DO jk = 2, jpkm1          ! Interior value
+         DO jk = 2, jpkm1            ! Interior value
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
                END DO
@@ -209,7 +264,13 @@
          ! 5. final trend with corrected fluxes
          ! ------------------------------------
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.  
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! total advective trends
@@ -247,4 +308,11 @@
       IF( wrk_not_released(3, 12,13) )   CALL ctl_stop('tra_adv_tvd: failed to release workspace arrays')
       !
+
+      !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    END SUBROUTINE tra_adv_tvd
 
@@ -266,8 +334,21 @@
       USE wrk_nemo, ONLY:   zbetup => wrk_3d_8  , zbetdo => wrk_3d_9    ! 3D workspace
       USE wrk_nemo, ONLY:   zbup   => wrk_3d_10 , zbdo   => wrk_3d_11   !  -     -
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zbetup zbetdo zbup zbdo :I :I :z
+
       !
       REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
+!     REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+
+!FTRANS pbef paft :I :I :z
+!FTRANS paa pbb pcc :I :I :z
+      REAL(wp), INTENT(in   ) ::   pbef(jpi,jpj,jpk), paft(jpi,jpj,jpk)     ! before & after field
+      REAL(wp), INTENT(inout) ::   paa(jpi,jpj,jpk)                         ! monotonic fluxes in the 1st direction
+      REAL(wp), INTENT(inout) ::   pbb(jpi,jpj,jpk)                         ! monotonic fluxes in the 2nd direction
+      REAL(wp), INTENT(inout) ::   pcc(jpi,jpj,jpk)                         ! monotonic fluxes in the 3rd direction
       !
       INTEGER ::   ji, jj, jk   ! dummy loop indices
@@ -294,4 +375,11 @@
          &        paft * tmask + zbig * ( 1.e0 - tmask )  )
 
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+               ikm1 = MAX(jk-1,1)
+               z2dtt = p2dt(jk)
+#else
       DO jk = 1, jpkm1
          ikm1 = MAX(jk-1,1)
@@ -299,4 +387,5 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
 
                ! search maximum in neighbourhood
@@ -335,7 +424,13 @@
       ! 3. monotonic flux in the i & j direction (paa & pbb)
       ! ----------------------------------------
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
                zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 3211)
@@ -29,4 +29,9 @@
 
    LOGICAL :: l_trd  ! flag to compute trends or not
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -78,4 +83,8 @@
       USE wrk_nemo, ONLY:   zltu => wrk_3d_3 , zltv => wrk_3d_4   !  -      -
       USE wrk_nemo, ONLY:   zti  => wrk_3d_5 , ztw  => wrk_3d_6   !  -      -
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwx zwy ztu ztv zltu zltv zti ztw :I :I :z
+
       !
       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
@@ -83,7 +92,21 @@
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+
+!FTRANS pun pvn pwn :I :I :z
+!FTRANS ptb ptn pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   pun(jpi,jpj,jpk)        ! ocean velocity component (u)
+      REAL(wp), INTENT(in   ) ::   pvn(jpi,jpj,jpk)        ! ocean velocity component (v)
+      REAL(wp), INTENT(in   ) ::   pwn(jpi,jpj,jpk)        ! ocean velocity component (w)
+!! DCSE_NEMO: Next two arguments made inout to silence the cray compile,
+!! which rightly complains about the call to nonosc_v (which also has them
+!! as inout) 
+      REAL(wp), INTENT(inout) ::   ptb(jpi,jpj,jpk,kjpt)   ! tracer fields (before)
+      REAL(wp), INTENT(inout) ::   ptn(jpi,jpj,jpk,kjpt)   ! tracer fields (now)
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)   ! tracer trend 
+
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -113,4 +136,9 @@
          zltu(:,:,jpk) = 0.e0       ;      zltv(:,:,jpk) = 0.e0
          !                                              
+#if defined key_z_first
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1                                 ! Horizontal slab
             !                                   
@@ -118,4 +146,5 @@
             DO jj = 1, jpjm1            ! First derivative (gradient)
                DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                   zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
                   zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
@@ -124,6 +153,13 @@
                END DO
             END DO
+#if defined key_z_first
+         END DO
+         DO jj = 2, jpjm1               ! Second derivative (divergence)
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
             DO jj = 2, jpjm1            ! Second derivative (divergence)
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zcoef = 1. / ( 6. * fse3t(ji,jj,jk) )
                   zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
@@ -137,7 +173,13 @@
          !    
          !  Horizontal advective fluxes               
+#if defined key_z_first
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1                                 ! Horizontal slab
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                   ! upstream transport
                   zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
@@ -158,8 +200,14 @@
 
          ! Horizontal advective trends
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             !  Tracer flux divergence at t-point added to the general trend
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! horizontal advective
@@ -203,7 +251,13 @@
          ! -------------------------------------------------------------------
          ! Interior value
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                    zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
                    zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
@@ -213,8 +267,15 @@
          END DO 
          ! update and guess with monotonic sheme
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+                  z2dtt = p2dt(jk)
+#else
          DO jk = 1, jpkm1
             z2dtt = p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
@@ -228,8 +289,15 @@
 
          !  antidiffusive flux : high order minus low order
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztw(ji,jj,1) = 0.e0   ! Surface value
+               DO jk = 2, jpkm1      ! Interior value
+#else
          ztw(:,:,1) = 0.e0       ! Surface value
          DO jk = 2, jpkm1        ! Interior value
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   ztw(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk)
                END DO
@@ -240,7 +308,13 @@
 
          !  final trend with corrected fluxes
+#if defined key_z_first
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1   ! vector opt.   
+#endif
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! k- vertical advective trends  
@@ -254,7 +328,14 @@
          !  Save the final vertical advective trends
          IF( l_trd )  THEN                        ! vertical advective trend diagnostics
-            DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
+            ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
+            DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                      z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) * zbtr
@@ -270,4 +351,11 @@
       IF( wrk_not_released(3, 1,2,3,4,5,6) )   CALL ctl_stop('tra_adv_ubs: failed to release workspace arrays')
       !
+
+      !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    END SUBROUTINE tra_adv_ubs
 
@@ -288,9 +376,20 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   zbetup => wrk_3d_1, zbetdo => wrk_3d_2   ! 3D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zbetup zbetdo :I :I :z
+
       !
       REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step
-      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
-      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field
-      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
+!     REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field
+!     REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction
+
+!FTRANS pbef paft pcc :I :I :z
+      REAL(wp), INTENT(inout) ::   pbef(jpi,jpj,jpk)   ! before field
+      REAL(wp), INTENT(inout) ::   paft(jpi,jpj,jpk)   ! after field
+      REAL(wp), INTENT(inout) ::   pcc(jpi,jpj,jpk)    ! monotonic flux in the k direction
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -313,8 +412,15 @@
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
       ! search maximum in neighbourhood
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+               ikm1 = MAX(jk-1,1)
+#else
       DO jk = 1, jpkm1
          ikm1 = MAX(jk-1,1)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
                   &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
@@ -327,8 +433,15 @@
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
       ! search minimum in neighbourhood
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+               ikm1 = MAX(jk-1,1)
+#else
       DO jk = 1, jpkm1
          ikm1 = MAX(jk-1,1)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
                   &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
@@ -346,8 +459,15 @@
       ! ------------------------------------------------------
 
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+               z2dtt = p2dt(jk)
+#else
       DO jk = 1, jpkm1
          z2dtt = p2dt(jk)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                ! positive & negative part of the flux
                zpos = MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
@@ -362,7 +482,13 @@
       ! monotonic flux in the k direction, i.e. pcc
       ! -------------------------------------------
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
                zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 3211)
@@ -35,4 +35,8 @@
 
    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
  
    !! * Substitutions
@@ -71,4 +75,6 @@
       INTEGER  ::   ji, jj, ik    ! dummy loop indices
       REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
+
+!FTRANS ztrdt :I :I :z
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt
       !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 3211)
@@ -65,4 +65,8 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1e2t               ! inverse of the cell surface at t-point      [1/m2]
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -105,4 +109,6 @@
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
+
+!FTRANS ztrdt ztrds :I :I :z
 
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
@@ -146,4 +152,8 @@
    END SUBROUTINE tra_bbl
 
+      !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    SUBROUTINE tra_bbl_dif( ptb, pta, kjpt )
@@ -173,6 +183,11 @@
       !
       INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
+!FTRANS ptb pta :I :I :z :I
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)    ! before tracer fields
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)    ! tracer trend 
       !
       INTEGER  ::   ji, jj, jn   ! dummy loop indices
@@ -220,6 +235,11 @@
       IF( wrk_not_released(2,1) )   CALL ctl_stop('tra_bbl_dif: failed to release workspace array')
       !
+
    END SUBROUTINE tra_bbl_dif
-   
+
+      !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    SUBROUTINE tra_bbl_adv( ptb, pta, kjpt )
@@ -239,6 +259,11 @@
       !!----------------------------------------------------------------------  
       INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
+!FTRANS ptb pta :I :I :z :I
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)    ! before tracer fields
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)    ! tracer trend 
       !
       INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
@@ -310,4 +335,8 @@
    END SUBROUTINE tra_bbl_adv
 
+      !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    SUBROUTINE bbl( kt, cdtype )
@@ -608,6 +637,11 @@
 
       !                             !* masked diffusive flux coefficients 
+#if defined key_z_first
+      ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask_1(:,:)
+      ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask_1(:,:)
+#else
       ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1)
       ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1)
+#endif
 
 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 3211)
@@ -64,4 +64,12 @@
    INTEGER  ::   nn_file =    2      ! = 1 create a damping.coeff NetCDF file 
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "dtatem_ftrans.h90"
+#  include "dtasal_ftrans.h90"
+#  include "tradmp_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -112,7 +120,13 @@
       !
       CASE( 0 )                   !==  newtonian damping throughout the water column  ==!
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
                   zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )
@@ -126,7 +140,13 @@
          !
       CASE ( 1 )                  !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
@@ -145,7 +165,13 @@
          !
       CASE ( 2 )                  !==  no damping in the mixed layer   ==!
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
@@ -252,5 +278,9 @@
       !! ** Action  : - resto, the damping coeff. for T and S
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::   presto   ! restoring coeff. (s-1)
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::   presto   ! restoring coeff. (s-1)
+!FTRANS presto :I :I :z
+      REAL(wp), INTENT(inout)  ::   presto(jpi,jpj,jpk)   ! restoring coeff. (s-1)
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -292,7 +322,13 @@
          z1_5d = 1._wp / ( 5._wp * rday )   ! z1_5d : 1 / 5days
 
+#if defined key_z_first
+         DO jj = 1, jpj             ! Compute arrays resto ; value for internal damping : 5 days
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1           ! Compute arrays resto ; value for internal damping : 5 days
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zlat = ABS( gphit(ji,jj) )
                   IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
@@ -311,4 +347,12 @@
    END SUBROUTINE dtacof_zoom
 
+!! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "dtatem_ftrans.h90"
+#  include "dtasal_ftrans.h90"
+#  include "tradmp_ftrans.h90"
 
    SUBROUTINE dtacof( kn_hdmp, pn_surf, pn_bot, pn_dep,  &
@@ -329,4 +373,8 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   zhfac => wrk_1d_1, zmrs => wrk_2d_1 , zdct  => wrk_3d_1   ! 1D, 2D, 3D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zdct :I :I :z
+
       !!
       INTEGER                         , INTENT(in   )  ::  kn_hdmp    ! damping option
@@ -336,5 +384,10 @@
       INTEGER                         , INTENT(in   )  ::  kn_file    ! save the damping coef on a file or not
       CHARACTER(len=3)                , INTENT(in   )  ::  cdtype     ! =TRA or TRC (tracer indicator)
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::  presto     ! restoring coeff. (s-1)
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::   presto   ! restoring coeff. (s-1)
+!FTRANS presto :I :I :z
+      REAL(wp), INTENT(inout)  ::   presto(jpi,jpj,jpk)   ! restoring coeff. (s-1)
+
       !
       INTEGER  ::   ji, jj, jk                  ! dummy loop indices
@@ -407,7 +460,13 @@
          zsdmp = 1._wp / ( pn_surf * rday )
          zbdmp = 1._wp / ( pn_bot  * rday )
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) )
                   !   ... Decrease the value in the vicinity of the coast
@@ -518,7 +577,17 @@
          END SELECT
 
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  presto(ji,jj,jk) = zmrs(ji,jj) * zhfac(jk) + ( 1._wp - zmrs(ji,jj) ) * presto(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             presto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1._wp - zmrs(:,:) ) * presto(:,:,jk)
          END DO
+#endif
 
          ! Mask resto array and set to 0 first and last levels
@@ -550,4 +619,12 @@
    END SUBROUTINE dtacof
 
+!! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "dtatem_ftrans.h90"
+#  include "dtasal_ftrans.h90"
+#  include "tradmp_ftrans.h90"
 
    SUBROUTINE cofdis( pdct )
@@ -571,9 +648,14 @@
       !!              - NetCDF file 'dist.coast.nc' 
       !!----------------------------------------------------------------------
-      USE ioipsl      ! IOipsl librairy
+      USE ioipsl      ! IOipsl library
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   zxt => wrk_2d_1 , zyt => wrk_2d_2 , zzt => wrk_2d_3, zmask => wrk_2d_4
       !!
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline
+!FTRANS pdct :I :I :z
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline
+
       !!
       INTEGER ::   ji, jj, jk, jl   ! dummy loop indices
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp_ftrans.h90	(revision 3211)
@@ -0,0 +1,22 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  tradmp_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices for
+   !!   public multi-dimensional arrays with a z-dimension declared in
+   !!   module tradmp.  It should be included wherever the module is used,
+   !!   and updated whenever a new public array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS strdmp :I :I :z
+!FTRANS ttrdmp :I :I :z
+!FTRANS resto :I :I :z
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 3211)
@@ -21,5 +21,8 @@
    USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine)
    USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
-   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
+
+!! DCSE_NEMO
+!  USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
+   USE traldf_iso_grif, ONLY : tra_ldf_iso_grif ! lateral mixing
    USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
    USE trdmod_oce      ! ocean space and time domain
@@ -41,4 +44,12 @@
    !                                                               !  (key_traldf_ano only)
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+!FTRANS t0_ldf s0_ldf :I :I :z
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -59,4 +70,5 @@
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
+!FTRANS ztrdt ztrds :I :I :z
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -115,4 +127,12 @@
    END SUBROUTINE tra_ldf
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+!FTRANS t0_ldf s0_ldf :I :I :z
 
    SUBROUTINE tra_ldf_init
@@ -240,10 +260,21 @@
       USE wrk_nemo, ONLY:   zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3   ! 3D workspaces
       USE wrk_nemo, ONLY:   zs_ref => wrk_3d_4, zsb => wrk_3d_5                     ! 3D workspaces
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zt_ref ztb zavt zs_ref zsb :I :I :z
       !
       USE zdf_oce         ! vertical mixing
       USE trazdf          ! vertical mixing: double diffusion
       USE zdfddm          ! vertical mixing: double diffusion
-      !
+
+#  include "zdf_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+
+      !
+#if defined key_z_first
+      INTEGER  ::   ji, jj, jk      ! Dummy loop indices
+#else
       INTEGER  ::   jk              ! Dummy loop indice
+#endif
       INTEGER  ::   ierr            ! local integer
       LOGICAL  ::   llsave          ! local logical
@@ -309,8 +340,19 @@
          s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)
       ELSE
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  t0_ldf(ji,jj,jk) = ( tsa(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) / ( z12 *rdttra(jk) )
+                  s0_ldf(ji,jj,jk) = ( tsa(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) / ( z12 *rdttra(jk) )
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )
             s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )
          END DO
+#endif
       ENDIF
       tsb(:,:,:,jp_tem) = ztb (:,:,:)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 3211)
@@ -34,4 +34,11 @@
 
    PUBLIC   tra_ldf_bilap   ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -77,4 +84,8 @@
       USE oce     , ONLY:   ztu  => ua       , ztv  => va                           ! (ua,va) used as workspace
       USE wrk_nemo, ONLY:   zeeu => wrk_2d_1 , zeev => wrk_2d_2 , zlt => wrk_2d_3   ! 2D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ztu ztv :I :I :z
+
       !!
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
@@ -82,6 +93,12 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+!FTRANS ptb pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)        ! before tracer fields
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)        ! tracer trend 
+
       !!
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 3211)
@@ -30,4 +30,11 @@
 
    PUBLIC   tra_ldf_bilapg   ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -68,10 +75,18 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   wk1 => wrk_4d_1 , wk2 => wrk_4d_2     ! 4D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS wk1 wk2 :I :I :z :
       !
       INTEGER         , INTENT(in   )                      ::   kt       ! ocean time-step index
       CHARACTER(len=3), INTENT(in   )                      ::   cdtype   ! =TRA or TRC (tracer indicator)
       INTEGER         , INTENT(in   )                      ::   kjpt     ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+!FTRANS ptb pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)        ! before tracer fields
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)        ! tracer trend
+
       !
       INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
@@ -105,7 +120,13 @@
       ! ---------------------------
       DO jn = 1, kjpt
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jj = 2, jpjm1
             DO jk = 1, jpkm1
                DO ji = 2, jpim1
+#endif
                   ! add it to the general tracer trends
                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + wk2(ji,jj,jk,jn)
@@ -119,4 +140,10 @@
    END SUBROUTINE tra_ldf_bilapg
 
+!! * Reset control of array index permutation
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
 
    SUBROUTINE ldfght ( kt, cdtype, pt, plt, kjpt, kaht )
@@ -163,14 +190,27 @@
       USE wrk_nemo, ONLY:   zftw => wrk_xz_1 , zdit  => wrk_xz_2 
       USE wrk_nemo, ONLY:   zdjt => wrk_xz_3 , zdj1t => wrk_xz_4
-      !
-      INTEGER         , INTENT(in )                              ::  kt      ! ocean time-step index
-      CHARACTER(len=3), INTENT(in )                              ::  cdtype  ! =TRA or TRC (tracer indicator) 
-      INTEGER         , INTENT(in )                              ::  kjpt    !: dimension of 
-      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) ::  pt      ! tracer fields ( before for 1st call
-      !                                                         ! and laplacian of these fields for 2nd call. 
-      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk,kjpt) ::  plt     !: partial harmonic operator applied to  pt  components except
-      !                                                             !: second order vertical derivative term  
-      INTEGER         , INTENT(in )                              ::  kaht    !: =1 multiply the laplacian by the eddy diffusivity coeff.
-      !                                                             !: =2 no multiplication 
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zftv :I :I :z
+
+      !
+      INTEGER, INTENT(in )                               ::  kt      ! ocean time-step index
+      CHARACTER(len=3), INTENT(in )                      ::  cdtype  ! =TRA or TRC (tracer indicator) 
+      INTEGER, INTENT(in )                               ::  kjpt    !: dimension of 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) ::  pt      ! tracer fields ( before for 1st call
+!     !                                                         ! and laplacian of these fields for 2nd call. 
+!     REAL(wp), INTENT(out), DIMENSION(jpi,jpj,jpk,kjpt) ::  plt     !: partial harmonic operator applied to  pt components except
+!     !                                                              !: second order vertical derivative term  
+
+!FTRANS pt plt :I :I :z :
+      REAL(wp), INTENT(in )  ::  pt(jpi,jpj,jpk,kjpt)      ! tracer fields ( before for 1st call
+      !                                                    ! and laplacian of these fields for 2nd call. 
+      REAL(wp), INTENT(out)  ::  plt(jpi,jpj,jpk,kjpt)     !: partial harmonic operator applied to  pt components except
+      !                                                    !: second order vertical derivative term  
+
+      INTEGER, INTENT(in )                               ::  kaht    !: =1 multiply the laplacian by the eddy diffusivity coeff.
+      !                                                              !: =2 no multiplication 
       !!
       INTEGER ::   ji, jj, jk,jn          ! dummy loop indices
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 3211)
@@ -38,4 +38,12 @@
    PUBLIC   tra_ldf_iso   ! routine called by step.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -92,6 +100,16 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace
-      USE wrk_nemo, ONLY:   zdkt => wrk_2d_1 , zdk1t => wrk_2d_2 , z2d  => wrk_2d_3   ! 2D workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zftu zftv :I :I :z
+#if defined key_z_first
+      USE wrk_nemo, ONLY:   wdkt => wrk_3d_9 , wdk1t => wrk_3d_10  ! 3D workspace
+!FTRANS wdkt wdk1t :I :I :z
+#else
+      USE wrk_nemo, ONLY:   zdkt => wrk_2d_1 , zdk1t => wrk_2d_2
+#endif
+      USE wrk_nemo, ONLY:   z2d  => wrk_2d_3                       ! 2D workspace
       USE wrk_nemo, ONLY:   zdit => wrk_3d_6 , zdjt  => wrk_3d_7 , ztfw => wrk_3d_8   ! 3D workspace
+!FTRANS zdit zdjt ztfw :I :I :z
+
       !
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
@@ -99,6 +117,12 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+!FTRANS ptb pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)        ! before and now tracer fields
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)        ! tracer trend 
+
       REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
       !
@@ -112,5 +136,9 @@
       !!----------------------------------------------------------------------
 
+#if defined key_z_first
+      IF( wrk_in_use(3, 6,7,8,9,10) .OR. wrk_in_use(2, 3) ) THEN
+#else
       IF( wrk_in_use(3, 6,7,8) .OR. wrk_in_use(2, 1,2,3) ) THEN
+#endif
           CALL ctl_stop('tra_ldf_iso : requested workspace array unavailable')   ;   RETURN
       ENDIF
@@ -135,7 +163,13 @@
 
          ! Horizontal tracer gradient 
+#if defined key_z_first
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                   zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
                   zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
@@ -155,4 +189,56 @@
          !!   II - horizontal trend  (full)
          !!----------------------------------------------------------------------
+#if defined key_z_first
+            ! 1. Vertical tracer gradient at level jk and jk+1
+            ! ------------------------------------------------
+            ! surface boundary condition: wdkt(jk=1)=wdkt(jk=2)
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  wdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1)
+               END DO
+               wdkt(ji,jj,1) = wdk1t(ji,jj,1)
+               DO jk = 2, jpkm1
+                  wdkt(ji,jj,jk) =  ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+            ! 2. Horizontal fluxes
+            ! --------------------   
+         DO jj = 1 , jpjm1
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
+                     &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
+                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
+                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
+                  zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+                  zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+                  zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk)   &
+                     &              + zcof1 * (  wdkt (ji+1,jj,jk) + wdk1t(ji,jj,jk)      &
+                     &                         + wdk1t(ji+1,jj,jk) + wdkt (ji,jj,jk)  )  ) * umask(ji,jj,jk)
+                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
+                     &              + zcof2 * (  wdkt (ji,jj+1,jk) + wdk1t(ji,jj,jk)      &
+                     &                         + wdk1t(ji,jj+1,jk) + wdkt (ji,jj,jk)  )  ) * vmask(ji,jj,jk)                  
+               END DO
+            END DO
+         END DO
+
+            ! II.4 Second derivative (divergence) and add to the general trend
+            ! ----------------------------------------------------------------
+         DO jj = 2 , jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+#else
 !CDIR PARALLEL DO PRIVATE( zdk1t ) 
          !                                                ! ===============
@@ -205,4 +291,5 @@
          END DO                                        !   End of slab  
          !                                             ! ===============
+#endif
          !
          ! "Poleward" diffusive heat or salt transports (T-S case only)
@@ -216,7 +303,13 @@
             z2d(:,:) = 0._wp 
             zztmp = rau0 * rcp 
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
                   END DO
@@ -227,7 +320,13 @@
             CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
             z2d(:,:) = 0._wp 
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
                   END DO
@@ -255,7 +354,13 @@
          
          ! interior (2=<jk=<jpk-1)
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
                   !
@@ -279,7 +384,13 @@
          ! I.5 Divergence of vertical fluxes added to the general tracer trend
          ! -------------------------------------------------------------------
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
@@ -291,6 +402,11 @@
       END DO
       !
+#if defined key_z_first
+      IF( wrk_not_released(3, 6,7,8,9,10) .OR.   &
+          wrk_not_released(2, 3) )       CALL ctl_stop('tra_ldf_iso: failed to release workspace arrays')
+#else
       IF( wrk_not_released(3, 6,7,8) .OR.   &
           wrk_not_released(2, 1,2,3) )   CALL ctl_stop('tra_ldf_iso: failed to release workspace arrays')
+#endif
       !
    END SUBROUTINE tra_ldf_iso
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 3211)
@@ -36,4 +36,13 @@
    REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt                 !  atypic workspace
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "traldf_iso_grif_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -93,4 +102,9 @@
       USE wrk_nemo, ONLY:   zdit => wrk_3d_6 , zdjt => wrk_3d_7 , ztfw => wrk_3d_8   ! 3D workspace
       USE wrk_nemo, ONLY:   z2d  => wrk_2d_1                                         ! 2D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zftu zftv :I :I :z
+!FTRANS zdit zdjt ztfw :I :I :z
+
       !
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
@@ -98,6 +112,13 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+!FTRANS ptb pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)        ! before and now tracer fields
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)        ! tracer trend 
+
       REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
       !
@@ -156,7 +177,13 @@
       DO ip = 0, 1
          DO kp = 0, 1
+#if defined key_z_first
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 1, jpjm1
                   DO ji = 1, fs_jpim1
+#endif
                      ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
                      zbu   = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
@@ -179,7 +206,13 @@
       DO jp = 0, 1
          DO kp = 0, 1
+#if defined key_z_first
+            DO jj = 1, jpjm1
+               DO ji=1, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 1, jpjm1
                   DO ji=1,fs_jpim1
+#endif
                      ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp)
                      zbv   = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
@@ -208,7 +241,14 @@
          zftv(:,:,:) = 0._wp
          !                                               
+#if defined key_z_first
+         !==  before lateral T & S gradients at T-level jk  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==!
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
+#endif
                   zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
                   zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
@@ -303,7 +343,13 @@
          END DO
          !
+#if defined key_z_first
+         DO jj = 2, jpjm1            !== Divergence of vertical fluxes added to the general tracer trend
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1            !== Divergence of vertical fluxes added to the general tracer trend
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
                      &                                / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
@@ -322,7 +368,13 @@
             z2d(:,:) = 0._wp 
             zztmp = rau0 * rcp 
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
                   END DO
@@ -333,7 +385,13 @@
             CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
             z2d(:,:) = 0._wp 
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
                   END DO
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif_ftrans.h90	(revision 3211)
@@ -0,0 +1,23 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  traldf_iso_grif_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices for
+   !!   public multi-dimensional arrays with a z-dimension declared in
+   !!   module traldf_iso_grif_ftrans.  It should be included wherever the
+   !!   module is used, and updated whenever a new public array is added
+   !!   to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS psix_eiv :I :I :z
+!FTRANS psiy_eiv :I :I :z
+!FTRANS ah_wslp2 :I :I :z
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 3211)
@@ -33,4 +33,10 @@
    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -64,4 +70,8 @@
       !!----------------------------------------------------------------------
       USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ztu ztv :I :I :z
+
       !
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
@@ -69,6 +79,12 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+
+!FTRANS ptb pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)        ! before and now tracer fields
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)        ! tracer trend 
       !
       INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 3211)
@@ -29,4 +29,9 @@
    PUBLIC   tra_npc       ! routine called by step.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -59,4 +64,8 @@
       USE wrk_nemo, ONLY:   ztrdt => wrk_3d_1 , ztrds => wrk_3d_2 , zrhop => wrk_3d_3
       USE wrk_nemo, ONLY:   zwx   => wrk_xz_1 , zwy   => wrk_xz_2 , zwz   => wrk_xz_3
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ztrdt ztrds zrhop :I :I :z
+
       !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
@@ -93,6 +102,11 @@
             !  Static instability pointer 
             ! ----------------------------
+#if defined key_z_first
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO ji = 1, jpi
+#endif
                   zwx(ji,jk) = ( zrhop(ji,jj,jk) - zrhop(ji,jj,jk+1) ) * tmask(ji,jj,jk+1)
                END DO
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 3211)
@@ -58,4 +58,12 @@
    REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -93,6 +101,8 @@
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
-      INTEGER  ::   jk, jn    ! dummy loop indices
-      REAL(wp) ::   zfact     ! local scalars
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zfact            ! local scalar
+
+!FTRANS ztrdt ztrds :I :I :z
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -142,7 +152,17 @@
       IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
          DO jn = 1, jpts
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  DO jk = 1, jpkm1
+                     tsn(ji,jj,jk,jn) = tsa(ji,jj,jk,jn)    
+                  END DO
+               END DO
+            END DO
+#else
             DO jk = 1, jpkm1
                tsn(:,:,jk,jn) = tsa(:,:,jk,jn)    
             END DO
+#endif
          END DO
       ELSE                                            ! Leap-Frog + Asselin filter time stepping
@@ -162,4 +182,15 @@
       ! trends computation
       IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  zfact = 1.e0 / r2dtra(jk)             
+                  ztrdt(ji,jj,jk) = ( tsb(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) ) * zfact
+                  ztrds(ji,jj,jk) = ( tsb(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) ) * zfact
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             zfact = 1.e0 / r2dtra(jk)             
@@ -167,4 +198,5 @@
             ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
          END DO
+#endif
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt )
          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds )
@@ -178,4 +210,12 @@
    END SUBROUTINE tra_nxt
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    SUBROUTINE tra_nxt_fix( kt, cdtype, ptb, ptn, pta, kjpt )
@@ -205,7 +245,14 @@
       CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
       INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
+!     REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
+!     REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+
+!FTRANS ptb ptn pta :I :I :z :
+      REAL(wp)        , INTENT(inout)             ::   ptb(jpi,jpj,jpk,kjpt)      ! before tracer fields
+      REAL(wp)        , INTENT(inout)             ::   ptn(jpi,jpj,jpk,kjpt)      ! now tracer fields
+      REAL(wp)        , INTENT(inout)             ::   pta(jpi,jpj,jpk,kjpt)      ! tracer trend
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -226,7 +273,13 @@
       DO jn = 1, kjpt
          !
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   ztn = ptn(ji,jj,jk,jn)                                    
                   ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
@@ -244,4 +297,12 @@
    END SUBROUTINE tra_nxt_fix
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
 
    SUBROUTINE tra_nxt_vvl( kt, cdtype, ptb, ptn, pta, kjpt )
@@ -272,7 +333,15 @@
       CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
       INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
+!     REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
+!     REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+
+!FTRANS ptb ptn pta :I :I :z :
+      REAL(wp)        , INTENT(inout)             ::   ptb(jpi,jpj,jpk,kjpt)      ! before tracer fields
+      REAL(wp)        , INTENT(inout)             ::   ptn(jpi,jpj,jpk,kjpt)      ! now tracer fields
+      REAL(wp)        , INTENT(inout)             ::   pta(jpi,jpj,jpk,kjpt)      ! tracer trend
+
       !!     
       LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! local logical
@@ -299,4 +368,12 @@
       !
       DO jn = 1, kjpt      
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  !! DCSE_NEMO: could try promoting these scalars to vectors
+                  zfact1 = atfp * rdttra(jk)
+                  zfact2 = zfact1 / rau0
+#else
          DO jk = 1, jpkm1
             zfact1 = atfp * rdttra(jk)
@@ -304,4 +381,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   ze3t_b = fse3t_b(ji,jj,jk)
                   ze3t_n = fse3t_n(ji,jj,jk)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 3211)
@@ -53,4 +53,10 @@
    REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -94,4 +100,7 @@
       USE wrk_nemo, ONLY:   ze0  => wrk_3d_1 , ze1  => wrk_3d_2 , ze2  => wrk_3d_3
       USE wrk_nemo, ONLY:   ze3  => wrk_3d_4 , zea  => wrk_3d_5
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ze0 ze1 ze2 ze3 zea :I :I :z
       !
       INTEGER, INTENT(in) ::   kt     ! ocean time-step
@@ -102,4 +111,6 @@
       REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
       REAL(wp) ::   zz0, zz1, z1_e3t     !    -         -
+
+!FTRANS ztrdt :I :I :z
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt
       !!----------------------------------------------------------------------
@@ -144,11 +155,27 @@
       IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  !
          !                                        ! ============================================== !
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  qsr_hc(:,:,jk) = ro0cpr * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             qsr_hc(:,:,jk) = ro0cpr * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
          END DO
+#endif
          !                                        Add to the general trend
+#if defined key_z_first
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   z1_e3t = zfact / fse3t(ji,jj,jk)
                   tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
@@ -198,4 +225,9 @@
                zea(:,:,1) =         qsr(:,:)
                !
+#if defined key_z_first
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     DO jk = 2, nksr+1
+#else
                DO jk = 2, nksr+1
 !CDIR NOVERRCHK
@@ -203,4 +235,5 @@
 !CDIR NOVERRCHK   
                      DO ji = 1, jpi
+#endif
                         zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     )
                         zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) )
@@ -216,14 +249,34 @@
                END DO
                !
+#if defined key_z_first
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     DO jk = 1, nksr                                  ! compute and add qsr trend to ta
+                        qsr_hc(ji,jj,jk) = ro0cpr * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
+                     END DO
+                  END DO
+               END DO
+#else
                DO jk = 1, nksr                                        ! compute and add qsr trend to ta
                   qsr_hc(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) )
                END DO
+#endif
                zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero
                CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution
                !
             ELSE                                                 !*  Constant Chlorophyll
+#if defined key_z_first
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     DO jk = 1, nksr
+                        qsr_hc(ji,jj,jk) =  etot3(ji,jj,jk) * qsr(ji,jj)
+                     END DO
+                  END DO
+               END DO
+#else
                DO jk = 1, nksr
                   qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:)
                END DO
+#endif
             ENDIF
 
@@ -236,7 +289,13 @@
                zz0   =        rn_abs   * ro0cpr
                zz1   = ( 1. - rn_abs ) * ro0cpr
+#if defined key_z_first
+               DO jj = 2, jpjm1
+                  DO ji = 2, jpim1
+                     DO jk = 1, nksr              ! solar heat absorbed at T-point in the top 400m 
+#else
                DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m 
                   DO jj = 2, jpjm1
                      DO ji = 2, jpim1
+#endif
                         zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
                         zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
@@ -246,7 +305,13 @@
                END DO
             ELSE                                               !* constant volume: coef. computed one for all
+#if defined key_z_first
+               DO jj = 2, jpjm1
+                  DO ji = 2, jpim1
+                     DO jk = 1, nksr
+#else
                DO jk = 1, nksr
                   DO jj = 2, jpjm1
                      DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                         qsr_hc(ji,jj,jk) =  etot3(ji,jj,jk) * qsr(ji,jj)
                      END DO
@@ -259,7 +324,13 @@
          !
          !                                        Add to the general trend
+#if defined key_z_first
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1
+               DO jk = 1, nksr
+#else
          DO jk = 1, nksr
             DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   z1_e3t = zfact / fse3t(ji,jj,jk)
                   tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
@@ -293,4 +364,10 @@
    END SUBROUTINE tra_qsr
 
+   !! * Reset control of array index permutation 
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
 
    SUBROUTINE tra_qsr_init
@@ -315,4 +392,8 @@
       USE wrk_nemo, ONLY:   ze0  => wrk_3d_1 , ze1  => wrk_3d_2 , ze2 => wrk_3d_3
       USE wrk_nemo, ONLY:   ze3  => wrk_3d_4 , zea  => wrk_3d_5
+
+      !! DCSE_NEMO: Need additional directives for renamed module variables
+!FTRANS ze0 ze1 ze2 ze3 zea :I :I :z
+
       !
       INTEGER  ::   ji, jj, jk     ! dummy loop indices
@@ -433,4 +514,15 @@
                   !
                   zcoef = ( 1. - rn_abs ) / 3.e0              ! equi-partition in R-G-B
+               
+#if defined key_z_first
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ze0(ji,jj,1) = rn_abs
+                        ze1(ji,jj,1) = zcoef
+                        ze2(ji,jj,1) = zcoef 
+                        ze3(ji,jj,1) = zcoef
+                        zea(ji,jj,1) = tmask(ji,jj,1)         ! = ( ze0+ze1+z2+ze3 ) * tmask
+                        DO jk = 2, nksr+1
+#else
                   ze0(:,:,1) = rn_abs
                   ze1(:,:,1) = zcoef
@@ -438,5 +530,4 @@
                   ze3(:,:,1) = zcoef
                   zea(:,:,1) = tmask(:,:,1)                   ! = ( ze0+ze1+z2+ze3 ) * tmask
-               
                   DO jk = 2, nksr+1
 !CDIR NOVERRCHK
@@ -444,4 +535,5 @@
 !CDIR NOVERRCHK   
                         DO ji = 1, jpi
+#endif
                            zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * xsi0r     )
                            zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * zekb(ji,jj) )
@@ -457,7 +549,17 @@
                   END DO 
                   !
+#if defined key_z_first
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        DO jk = 1, nksr
+                           etot3(ji,jj,jk) = ro0cpr * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) ) 
+                        END DO
+                     END DO
+                  END DO
+#else
                   DO jk = 1, nksr
                      etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) 
                   END DO
+#endif
                   etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero
                ENDIF
@@ -481,4 +583,18 @@
                zz0 =        rn_abs   * ro0cpr
                zz1 = ( 1. - rn_abs ) * ro0cpr
+#if defined key_z_first
+               DO jj = 1, jpj                     !*  solar heat absorbed at T-point computed once for all
+                  DO ji = 1, jpi
+                     DO jk = 1, nksr                         ! top 400 meters
+                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
+                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
+                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) 
+                     END DO
+                     DO jk = nksr+1, jpk
+                        etot3(ji,jj,jk) = 0.e0       ! below 400m set to zero
+                     END DO
+                  END DO
+               END DO
+#else
                DO jk = 1, nksr                    !*  solar heat absorbed at T-point computed once for all
                   DO jj = 1, jpj                              ! top 400 meters
@@ -491,4 +607,5 @@
                END DO
                etot3(:,:,nksr+1:jpk) = 0.e0                   ! below 400m set to zero
+#endif
                !
             ENDIF
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 3211)
@@ -33,4 +33,9 @@
 
    PUBLIC   tra_sbc    ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
@@ -108,4 +113,6 @@
       INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
       REAL(wp) ::   zfact, z1_e3t, zsrau, zdep
+
+!FTRANS ztrdt ztrds :I :I :z
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traswp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traswp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traswp.F90	(revision 3211)
@@ -12,4 +12,7 @@
    PUBLIC   tra_swap     ! routine called by step.F90
    PUBLIC   tra_unswap   ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
 
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 3211)
@@ -40,4 +40,12 @@
    INTEGER ::   nzdf = 0   ! type vertical diffusion algorithm used (defined from ln_zdf...  namlist logicals)
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -59,5 +67,6 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !!
-      INTEGER  ::   jk                   ! Dummy loop indices
+      INTEGER  ::   ji, jj, jk           ! Dummy loop indices
+!FTRANS ztrdt ztrds :I :I :z
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
       !!---------------------------------------------------------------------
@@ -88,8 +97,19 @@
 
       IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  ztrdt(ji,jj,jk) = ( ( tsa(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(ji,jj,jk)
+                  ztrds(ji,jj,jk) = ( ( tsa(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk)
             ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk)
          END DO
+#endif
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt )
          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds )
@@ -119,4 +139,5 @@
       USE zdfgls
       USE zdfkpp
+#  include "zdftke_ftrans.h90"
       !!----------------------------------------------------------------------
 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 3211)
@@ -36,4 +36,12 @@
 
    PUBLIC   tra_zdf_exp   ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
 
    !! * Substitutions
@@ -75,4 +83,7 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   zwx => wrk_3d_6, zwy => wrk_3d_7     ! 3D workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zwx zwy :I :I :z
       !
       INTEGER                              , INTENT(in   ) ::   kt          ! ocean time-step index
@@ -81,6 +92,12 @@
       INTEGER                              , INTENT(in   ) ::   kn_zdfexp   ! number of sub-time step
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt        ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend 
+
+!FTRANS ptb pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)         ! before and now tracer fields
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)         ! tracer trend 
       !
       INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices
@@ -116,7 +133,13 @@
          DO jl = 1, kn_zdfexp
             !                     ! first vertical derivative
+#if defined key_z_first
+            DO jj = 2, jpjm1 
+               DO ji = 2, jpim1   ! vector opt.
+                  DO jk = 2, jpk
+#else
             DO jk = 2, jpk
                DO jj = 2, jpjm1 
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      zave3r = 1.e0 / fse3w_n(ji,jj,jk) 
                      IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
@@ -129,7 +152,14 @@
             END DO
             !
+#if defined key_z_first
+            ! second vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
+            DO jj = 2, jpjm1 
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1      ! second vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
                DO jj = 2, jpjm1 
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      ze3tr = zlavmr / fse3t_n(ji,jj,jk)
                      zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr
@@ -143,7 +173,13 @@
          ! ------------------------------
          IF( lk_vvl ) THEN          ! variable level thickness : leap-frog on tracer*e3t
+#if defined key_z_first
+            DO jj = 2, jpjm1 
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1 
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk)                          ! before e3t
                      ztra  = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt(jk) * pta(ji,jj,jk,jn)       ! total trends * 2*rdt 
@@ -153,7 +189,13 @@
             END DO
          ELSE                       ! fixed level thickness : leap-frog on tracers
+#if defined key_z_first
+            DO jj = 2, jpjm1 
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1 
                   DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                      pta(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt(jk) * pta(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                   END DO
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 3211)
@@ -42,4 +42,15 @@
 
    REAL(wp) ::  r_vvl     ! variable volume indicator, =1 if lk_vvl=T, =0 otherwise 
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "trc_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+#  include "traldf_iso_grif_ftrans.h90"
 
    !! * Substitutions
@@ -77,4 +88,8 @@
       USE oce     , ONLY:   zwd => ua       , zws => va         ! (ua,va) used as 3D workspace
       USE wrk_nemo, ONLY:   zwi => wrk_3d_6 , zwt => wrk_3d_7   ! 3D workspace 
+
+      !! DCSE_NEMO: Need additional directives for renamed module variables
+!FTRANS zwd zws :I :I :z
+!FTRANS zwi zwt :I :I :z
       !
       INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
@@ -82,6 +97,12 @@
       INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+
+!FTRANS ptb pta :I :I :z :
+      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)      ! before and now tracer fields
+      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)      ! tracer trend 
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
@@ -115,15 +136,43 @@
             !
             ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers
+#if defined key_z_first
+            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwt(ji,jj,1) = 0._wp
+                     DO jk = 2, jpk
+                        zwt(ji,jj,jk) = avt  (ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+            ELSE                                
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwt(ji,jj,1) = 0._wp
+                     DO jk = 2, jpk
+                        zwt(ji,jj,jk) = fsavs(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+#else
             IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt  (:,:,2:jpk)
             ELSE                                            ;   zwt(:,:,2:jpk) = fsavs(:,:,2:jpk)
             ENDIF
             zwt(:,:,1) = 0._wp
+#endif
             !
 #if defined key_ldfslp
             ! isoneutral diffusion: add the contribution 
             IF( ln_traldf_grif    ) THEN     ! Griffies isoneutral diff
+#if defined key_z_first
+               DO jj = 2, jpjm1
+                  DO ji = 2, jpim1
+                     DO jk = 2, jpkm1
+#else
                DO jk = 2, jpkm1
                   DO jj = 2, jpjm1
                      DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                         zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)       
                      END DO
@@ -131,7 +180,13 @@
                END DO
             ELSE IF( l_traldf_rot ) THEN     ! standard isoneutral diff
+#if defined key_z_first
+               DO jj = 2, jpjm1
+                  DO ji = 2, jpim1
+                     DO jk = 2, jpkm1
+#else
                DO jk = 2, jpkm1
                   DO jj = 2, jpjm1
                      DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                         zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk)                       &
                            &                          * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
@@ -143,4 +198,15 @@
 #endif
             ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 1, jpkm1
+                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * fse3t_a(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * fse3t_n(ji,jj,jk)   ! now   scale factor at T-point
+                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) )
+                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )
+                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
+                 END DO
+#else
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
@@ -154,4 +220,5 @@
                END DO
             END DO
+#endif
             !
             !! Matrix inversion from the first level
@@ -176,4 +243,12 @@
             ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
             ! done once for all passive tracers (so included in the IF instruction)
+#if defined key_z_first
+                  zwt(ji,jj,1) = zwd(ji,jj,1)
+                  DO jk = 2, jpkm1
+                    zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
+                  END DO
+               END DO
+            END DO
+#else
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1
@@ -188,8 +263,22 @@
                END DO
             END DO
+#endif
             !
          END IF 
          !         
          ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1)
+               ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1)
+               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
+               DO jk = 2, jpkm1
+                  ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk)
+                  ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t  (ji,jj,jk)
+                  zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn)   ! zrhs=right hand side 
+                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
+               END DO
+#else
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
@@ -209,6 +298,16 @@
             END DO
          END DO
+#endif
 
          ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
+#if defined key_z_first
+               pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
+               DO jk = jpk-2, 1, -1
+                  pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) )   &
+                     &             / zwt(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
@@ -224,4 +323,5 @@
             END DO
          END DO
+#endif
          !                                            ! ================= !
       END DO                                          !  end tracer loop  !
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 3211)
@@ -26,4 +26,8 @@
 
    PUBLIC   zps_hde    ! routine called by step.F90
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
 
    !! * Substitutions
@@ -87,7 +91,16 @@
       INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
       INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
+!FTRANS pta :I :I :z :
+      REAL(wp), INTENT(in   )                      ::  pta(jpi,jpj,jpk,kjpt)         ! 4D tracers fields
+
       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
+
+!     REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
+!FTRANS prd :I :I :z
+      REAL(wp), INTENT(in   ), OPTIONAL            ::  prd(jpi,jpj,jpk)              ! 3D density anomaly fields
+
       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad. of prd at u- & v-pts 
       !
@@ -126,5 +139,9 @@
                   zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
                   ! gradient of  tracers
+#if defined key_z_first
+                  pgtu(ji,jj,jn) = umask_1(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+#else
                   pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+#endif
                ELSE                           ! case 2
                   zmaxu = -ze3wu / fse3w(ji,jj,iku)
@@ -132,5 +149,9 @@
                   zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
                   ! gradient of tracers
+#if defined key_z_first
+                  pgtu(ji,jj,jn) = umask_1(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+#else
                   pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+#endif
                ENDIF
                !
@@ -141,5 +162,9 @@
                   ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
                   ! gradient of tracers
+#if defined key_z_first
+                  pgtv(ji,jj,jn) = vmask_1(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+#else
                   pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+#endif
                ELSE                           ! case 2
                   zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
@@ -147,5 +172,9 @@
                   ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
                   ! gradient of tracers
+#if defined key_z_first
+                  pgtv(ji,jj,jn) = vmask_1(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+#else
                   pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+#endif
                ENDIF
 # if ! defined key_vectopt_loop
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90	(revision 3211)
@@ -39,4 +39,12 @@
    PUBLIC   trd_icp_init  ! called by opa.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trdmld_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -121,6 +129,13 @@
       !!              momentum equations at every time step frequency nn_trd.
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx   ! Temperature or U trend 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy   ! Salinity    or V trend
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx   ! Temperature or U trend 
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy   ! Salinity    or V trend
+
+!FTRANS ptrd3dx ptrd3dy :I :I :z
+      REAL(wp), INTENT(inout) ::   ptrd3dx(jpi,jpj,jpk)   ! Temperature or U trend 
+      REAL(wp), INTENT(inout) ::   ptrd3dy(jpi,jpj,jpk)   ! Salinity    or V trend
+
       INTEGER,                          INTENT(in   ) ::   ktrd      ! momentum or tracer trend index
       CHARACTER(len=3),                 INTENT(in   ) ::   ctype     ! momentum ('DYN') or tracers ('TRA') trends
@@ -132,7 +147,13 @@
       !
       CASE( 'DYN' )              ! Momentum        
+#if defined key_z_first
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpjm1
                DO ji = 1, jpim1
+#endif
                   ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
                   ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
@@ -144,8 +165,19 @@
          !
       CASE( 'TRA' )              ! Tracers
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
             ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
          END DO
+#endif
          !
       END SELECT   
@@ -156,16 +188,40 @@
          umo(ktrd) = 0._wp
          vmo(ktrd) = 0._wp
+#if defined key_z_first
+         !! DCSE_NEMO: this changes the order of summation
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  umo(ktrd) = umo(ktrd) + ptrd3dx(ji,jj,jk) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+                  vmo(ktrd) = vmo(ktrd) + ptrd3dy(ji,jj,jk) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) )
             vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) )
          END DO
+#endif
          !
       CASE( 'TRA' )              ! Tracers
          tmo(ktrd) = 0._wp
          smo(ktrd) = 0._wp
+#if defined key_z_first
+         !! DCSE_NEMO: this changes the order of summation
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  tmo(ktrd) = tmo(ktrd) + ptrd3dx(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  smo(ktrd) = smo(ktrd) + ptrd3dy(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             tmo(ktrd) = tmo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
             smo(ktrd) = smo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
          END DO
+#endif
          !
       END SELECT
@@ -175,16 +231,43 @@
       CASE( 'DYN' )              ! Momentum
          hke(ktrd) = 0._wp
+#if defined key_z_first
+         !! DCSE_NEMO: this changes the order of summation
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)   &
+                     &                  + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)  
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             hke(ktrd) = hke(ktrd) + SUM(   un(:,:,jk) * ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk)   &
                &                         + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk)   )
          END DO
+#endif
          !
       CASE( 'TRA' )              ! Tracers
          t2(ktrd) = 0._wp
          s2(ktrd) = 0._wp
+#if defined key_z_first
+         !! DCSE_NEMO: this changes the order of summation
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * tn(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk)
+                  s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * sn(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
-            t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(ji,jj,jk) * tn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
-            s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(ji,jj,jk) * sn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
-         END DO
+         !! DCSE_NEMO: This looks plain wrong!
+!           t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(ji,jj,jk) * tn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
+!           s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(ji,jj,jk) * sn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
+            t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(:,:,jk) * tn(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
+            s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(:,:,jk) * sn(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
+         END DO
+#endif
          !
       END SELECT
@@ -210,7 +293,19 @@
       ! Total volume at t-points:
       tvolt = 0._wp
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               tvolt = tvolt + e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1, jpkm1
-         tvolt = SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )
+      !! DCSE_NEMO: This looks plain wrong
+!        tvolt = SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )
+         tvolt = tvolt + SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )
       END DO
+#endif
       IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain
 
@@ -225,7 +320,13 @@
       tvolv = 0._wp
 
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
                tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
@@ -254,4 +355,8 @@
       USE wrk_nemo, ONLY:   zkepe => wrk_3d_1 , zkx => wrk_3d_2   ! 3D workspace
       USE wrk_nemo, ONLY:   zky   => wrk_3d_3 , zkz => wrk_3d_4   !  -      -
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zkepe zkx zky zkz :I :I :z
+
       !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
@@ -281,13 +386,30 @@
 
          zcof = 0.5_wp / rau0             ! Density flux at w-point
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zkz(ji,jj,1) = 0._wp
+               DO jk = 2, jpk
+                  zkz(ji,jj,jk) = e1e2t(ji,jj) * wn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) ) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+#else
          zkz(:,:,1) = 0._wp
          DO jk = 2, jpk
             zkz(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:)
          END DO
+#endif
          
          zcof   = 0.5_wp / rau0           ! Density flux at u and v-points
+#if defined key_z_first
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 1, jpjm1
                DO ji = 1, jpim1
+#endif
                   zkx(ji,jj,jk) = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
                   zky(ji,jj,jk) = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
@@ -296,7 +418,13 @@
          END DO
          
+#if defined key_z_first
+         DO jj = 2, jpjm1                 ! Density flux divergence at t-point
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1                 ! Density flux divergence at t-point
             DO jj = 2, jpjm1
                DO ji = 2, jpim1
+#endif
                   zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               &
                      &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               &
@@ -310,7 +438,17 @@
          ! ----------------------------------------
          peke = 0._wp
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  peke = peke + zkepe(ji,jj,jk) * fsdept(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             peke = peke + SUM( zkepe(:,:,jk) * fsdept(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
          END DO
+#endif
          peke = grav * peke
 
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90	(revision 3211)
@@ -53,4 +53,13 @@
    INTEGER ::   ionce, icount                   
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trdmld_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -98,6 +107,12 @@
       INTEGER                         , INTENT( in ) ::   ktrd       ! ocean trend index
       CHARACTER(len=2)                , INTENT( in ) ::   ctype      ! 2D surface/bottom or 3D interior physics
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pttrdmld   ! temperature trend 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pstrdmld   ! salinity trend 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pttrdmld   ! temperature trend 
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pstrdmld   ! salinity trend 
+
+!FTRANS pttrdmld pstrdmld :I :I :z
+      REAL(wp), INTENT( in ) ::   pttrdmld(jpi,jpj,jpk)   ! temperature trend 
+      REAL(wp), INTENT( in ) ::   pstrdmld(jpi,jpj,jpk)   ! salinity trend 
       !
       INTEGER ::   ji, jj, jk, isum
@@ -160,8 +175,15 @@
          ! ... Weights for vertical averaging
          wkx(:,:,:) = 0.e0
+#if defined key_z_first
+         DO jj = 1,jpj                 ! initialize wkx with vertical scale factor in mixed-layer
+            DO ji = 1,jpi
+               DO jk = 1, jpktrd
+                  IF( jk < nmld(ji,jj) )          wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+#else
          DO jk = 1, jpktrd             ! initialize wkx with vertical scale factor in mixed-layer
             DO jj = 1,jpj
                DO ji = 1,jpi
                   IF( jk - nmld(ji,jj) < 0.e0 )   wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+#endif
                END DO
             END DO
@@ -169,11 +191,31 @@
          
          rmld(:,:) = 0.e0                ! compute mixed-layer depth : rmld
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpktrd
+                  rmld(ji,jj) = rmld(ji,jj) + wkx(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpktrd
             rmld(:,:) = rmld(:,:) + wkx(:,:,jk)
          END DO
-         
+#endif
+         
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpktrd             ! compute integration weights
+                  wkx(ji,jj,jk) = wkx(ji,jj,jk) / MAX( 1., rmld(ji,jj) )
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpktrd             ! compute integration weights
             wkx(:,:,jk) = wkx(:,:,jk) / MAX( 1., rmld(:,:) )
          END DO
+#endif
 
          icount = 0                    ! <<< flag = off : control surface & integr. weights
@@ -186,8 +228,19 @@
       SELECT CASE (ctype)
       CASE ( '3D' )   ! mean T/S trends in the mixed-layer
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpktrd
+                  tmltrd(ji,jj,ktrd) = tmltrd(ji,jj,ktrd) + pttrdmld(ji,jj,jk) * wkx(ji,jj,jk)   ! temperature
+                  smltrd(ji,jj,ktrd) = smltrd(ji,jj,ktrd) + pstrdmld(ji,jj,jk) * wkx(ji,jj,jk)   ! salinity
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpktrd
             tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,jk) * wkx(:,:,jk)   ! temperature
             smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,jk) * wkx(:,:,jk)   ! salinity
          END DO
+#endif
       CASE ( '2D' )   ! forcing at upper boundary of the mixed-layer
          tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,1) * wkx(:,:,1)        ! non penetrative
@@ -198,5 +251,15 @@
       !
    END SUBROUTINE trd_mld_zint
-    
+
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "trdmld_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+
 
    SUBROUTINE trd_mld( kt )
@@ -261,5 +324,11 @@
       LOGICAL :: lldebug = .TRUE.
       REAL(wp) :: zavt, zfn, zfn2
+
+#if defined key_z_first
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztmltrd2, zsmltrd2   ! only needed for mean diagnostics
+#else
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztmltrd2, zsmltrd2   ! only needed for mean diagnostics
+#endif
+
 #if defined key_dimgout
       INTEGER ::  iyear,imon,iday
@@ -269,4 +338,11 @@
       
       ! Check that the workspace arrays are all OK to be used
+#if defined key_z_first
+      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) ) THEN
+         CALL ctl_stop('trd_mld : requested workspace arrays unavailable')   ;   RETURN
+      END IF
+      ALLOCATE( ztmltrd2(jpi,jpj,jpltrd) )
+      ALLOCATE( zsmltrd2(jpi,jpj,jpltrd) )
+#else
       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)  .OR. &
           wrk_in_use(3, 1,2)                                 ) THEN
@@ -280,4 +356,5 @@
       ztmltrd2 => wrk_3d_1(1:,:,1:jpltrd)
       zsmltrd2 => wrk_3d_2(1:,:,1:jpltrd)
+#endif
 
       ! ======================================================================
@@ -333,8 +410,19 @@
       ! --------------------------------
       tml(:,:) = 0.e0   ;   sml(:,:) = 0.e0
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpktrd - 1
+               tml(ji,jj) = tml(ji,jj) + wkx(ji,jj,jk) * tn(ji,jj,jk)
+               sml(ji,jj) = sml(ji,jj) + wkx(ji,jj,jk) * sn(ji,jj,jk) 
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1, jpktrd - 1
          tml(:,:) = tml(:,:) + wkx(:,:,jk) * tn(:,:,jk)
          sml(:,:) = sml(:,:) + wkx(:,:,jk) * sn(:,:,jk) 
       END DO
+#endif
 
       ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window    
@@ -740,7 +828,13 @@
       IF( lrst_oce )   CALL trd_mld_rst_write( kt ) 
 
+#if defined key_z_first
+      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) )   &
+          CALL ctl_stop('trd_mld : failed to release workspace arrays.')
+      DEALLOCATE( ztmltrd2, zsmltrd2 )
+#else
       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)  .OR. &
           wrk_not_released(3, 1,2)                                )   &
           CALL ctl_stop('trd_mld : failed to release workspace arrays.')
+#endif
       !
    END SUBROUTINE trd_mld
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90	(revision 3211)
@@ -79,4 +79,8 @@
       smltrd_csum_ln,               & !:    ( idem for salinity )
       smltrd_csum_ub                  !: 
+
+   !! * Control permutation of array indices
+#  include "trdmld_oce_ftrans.h90"
+
 #endif
    !!----------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce_ftrans.h90	(revision 3211)
@@ -0,0 +1,20 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  trdmld_oce_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices
+   !!   for multi-dimensional arrays with a z-dimension declared in module
+   !!   trdmld_oce.  It should be included wherever the module is used,
+   !!   and updated whenever a new array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS wkx :I :I :z
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90	(revision 3211)
@@ -21,4 +21,7 @@
   
    INTEGER ::   nummldw         ! logical unit for mld restart
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
 
    !!---------------------------------------------------------------------------------
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90	(revision 3211)
@@ -34,4 +34,11 @@
    PUBLIC trd_mod_init         ! called by opa.F90 module
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -62,4 +69,6 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend 
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend
+!FTRANS ptrdx ptrdy :I :I :z
+
       CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type 'DYN'/'TRA'
       INTEGER                   , INTENT(in   ) ::   kt      ! time step
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90	(revision 3211)
@@ -72,4 +72,8 @@
    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_bfr = 12     !: bottom friction 
 
+   !! * Control permutation of array indices
+   ! DCSE_NEMO: Nothing needed in this module, but beware those that use it
+   ! for trdmld_oce variables
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 3211)
@@ -25,4 +25,10 @@
  
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt  !:
+
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+   !! These are all private to the module,
+   !! so we do not need a separate file of ftrans directives
+!FTRANS trdtx trdty trdt :I :I :z
 
    !! * Substitutions
@@ -63,4 +69,7 @@
       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE wrk_nemo, ONLY:   ztrds => wrk_3d_10   ! 3D workspace
+      !! DCSE_NEMO: Need additional directives for renamed module variables
+!FTRANS ztrds :I :I :z
+
       !
       INTEGER                         , INTENT(in)           ::  kt      ! time step
@@ -68,7 +77,14 @@
       INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
       INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity 
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable 
+
+!FTRANS ptrd pun ptra :I :I :z
+      REAL(wp), INTENT(in)           ::  ptrd(jpi,jpj,jpk)    ! tracer trend  or flux
+      REAL(wp), INTENT(in), OPTIONAL ::  pun(jpi,jpj,jpk)     ! velocity 
+      REAL(wp), INTENT(in), OPTIONAL ::  ptra(jpi,jpj,jpk)    ! Tracer variable 
       !!----------------------------------------------------------------------
 
@@ -142,4 +158,8 @@
    END SUBROUTINE trd_tra
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "dom_oce_ftrans.h90"
+!FTRANS trdtx trdty trdt :I :I :z
 
    SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
@@ -153,9 +173,19 @@
       !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
       !!----------------------------------------------------------------------
-      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction
-      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction
-      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer 
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction
+!     REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction
+!     REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer 
+
+!FTRANS pf pun ptn :I :I :z
+      REAL(wp)        , INTENT(in )            ::   pf(jpi,jpj,jpk)      ! advective flux in one direction
+      REAL(wp)        , INTENT(in )            ::   pun(jpi,jpj,jpk)     ! now velocity  in one direction
+      REAL(wp)        , INTENT(in )            ::   ptn(jpi,jpj,jpk)     ! now or before tracer 
       CHARACTER(len=1), INTENT(in )                         ::   cdir    ! X/Y/Z direction
-      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction
+
+!     REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction
+!FTRANS ptrd :I :I :z
+      REAL(wp)        , INTENT(out)            ::   ptrd(jpi,jpj,jpk)    ! advective trend in one direction
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -176,7 +206,13 @@
       !
       !
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
                ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    &
@@ -200,7 +236,14 @@
       INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
       INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable 
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity 
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable 
+
+!FTRANS ptrd pu ptra :I :I :z
+      REAL(wp), INTENT(in)           ::  ptrd(jpi,jpj,jpk)    ! tracer trend  or flux
+      REAL(wp), INTENT(in), OPTIONAL ::  pu(jpi,jpj,jpk)      ! velocity 
+      REAL(wp), INTENT(in), OPTIONAL ::  ptra(jpi,jpj,jpk)    ! Tracer variable 
+
       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),   &
          &                                                               ktrd, ktra, ctype, kt
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 3211)
@@ -54,4 +54,10 @@
          
    CHARACTER(len=12) ::   cvort
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
 
    !! * Substitutions
@@ -204,6 +210,12 @@
       !
       INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend 
+!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
+
+!FTRANS putrdvor pvtrdvor :I :I :z
+      REAL(wp), INTENT(inout) ::   putrdvor(jpi,jpj,jpk)   ! u vorticity trend 
+      REAL(wp), INTENT(inout) ::   pvtrdvor(jpi,jpj,jpk)   ! v vorticity trend
       !
       INTEGER ::   ji, jj, jk   ! dummy loop indices
@@ -227,8 +239,19 @@
       !  =====================================
       ! putrdvor and pvtrdvor terms
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+               zudpvor(ji,jj) = zudpvor(ji,jj) + putrdvor(ji,jj,jk) * fse3u(ji,jj,jk) * e1u(ji,jj) * umask(ji,jj,jk)
+               zvdpvor(ji,jj) = zvdpvor(ji,jj) + pvtrdvor(ji,jj,jk) * fse3v(ji,jj,jk) * e2v(ji,jj) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1,jpk
         zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * fse3u(:,:,jk) * e1u(:,:) * umask(:,:,jk)
         zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * fse3v(:,:,jk) * e2v(:,:) * vmask(:,:,jk)
       END DO
+#endif
 
       ! Save Beta.V term to avoid average before Curl
@@ -280,4 +303,10 @@
    END SUBROUTINE trd_vor_zint_3d
 
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
 
    SUBROUTINE trd_vor( kt )
@@ -327,8 +356,19 @@
       
       ! Vertically averaged velocity
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk - 1
+               zun(ji,jj) = zun(ji,jj) + e1u(ji,jj) * un(ji,jj,jk) * fse3u(ji,jj,jk)
+               zvn(ji,jj) = zvn(ji,jj) + e2v(ji,jj) * vn(ji,jj,jk) * fse3v(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1, jpk - 1
          zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk)
          zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)
       END DO
+#endif
  
       zun(:,:) = zun(:,:) * hur(:,:)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 3211)
@@ -40,7 +40,12 @@
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   avtb_2d        !: horizontal shape of background Kz profile
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   bfrua, bfrva   !: Bottom friction coefficients set in zdfbfr
-   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts       [m2/s]
-   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt [m2/s]
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts
+   !                                                                         !       [m2/s]
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt
+   !                                                                         !       [m2/s]
  
+   !! * Control permutation of array indices
+#  include "zdf_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce_ftrans.h90	(revision 3211)
@@ -0,0 +1,23 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  zdf_oce_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices for
+   !!   public multi-dimensional arrays with a z-dimension declared in module
+   !!   zdf_oce.  It should be included wherever the module is used,
+   !!   and updated whenever a new public array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS avmu :I :I :z
+!FTRANS avm  :I :I :z
+!FTRANS avmv :I :I :z
+!FTRANS avt  :I :I :z
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 3211)
@@ -38,4 +38,9 @@
    
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  bfrcoef2d   ! 2D bottom drag coefficient
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 3211)
@@ -38,4 +38,10 @@
    REAL(wp) ::   rn_avts  = 1.e-4_wp   ! maximum value of avs for salt fingering
    REAL(wp) ::   rn_hsbfr = 1.6_wp     ! heat/salt buoyancy flux ratio
+
+   !! * Control permutation of array indices
+#  include "zdfddm_ftrans.h90"
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
 
    !! * Substitutions
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_ftrans.h90	(revision 3211)
@@ -0,0 +1,21 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  zdfddm_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices for
+   !!   public, multi-dimensional arrays with a z-dimension declared in module
+   !!   zdfddm.  It should be included wherever the module is used,
+   !!   and updated whenever a new, public array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS avs  :I :I :z
+!FTRANS rrau  :I :I :z
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 3211)
@@ -28,4 +28,9 @@
    PUBLIC   zdf_evd    ! called by step.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -53,4 +58,8 @@
       !!----------------------------------------------------------------------
       USE oce,   zavt_evd => ua , zavm_evd => va  ! (ua,va) used ua workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ua va :I :I :z
+
       !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step indexocean time step
@@ -74,4 +83,9 @@
          zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application
          !
+#if defined key_z_first
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1 
 #if defined key_vectopt_loop
@@ -82,4 +96,6 @@
                DO ji = 2, jpi
 #endif
+#endif
+
 #if defined key_zdfkpp
                   ! no evd mixing in the boundary layer with KPP
@@ -105,4 +121,9 @@
          !
       CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12) 
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
 !!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL! 
@@ -114,4 +135,6 @@
                DO ji = 1, jpi
 #endif
+#endif
+
 #if defined key_zdfkpp
                   ! no evd mixing in the boundary layer with KPP
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 3211)
@@ -39,9 +39,23 @@
    LOGICAL , PUBLIC, PARAMETER ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points
+   !! DCSE_NEMO: does not need to be public
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy
+
+   !! DCSE_NEMO: does not need to be public
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length
+
+   !! DCSE_NEMO: does not need to be public
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function
+
+   !! DCSE_NEMO: does not need to be public
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points
+
+   !! DCSE_NEMO: does not need to be public
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points
 
    !                                         !!! ** Namelist  namzdf_gls  **
@@ -102,4 +116,13 @@
    REAL(wp) ::   rpsi3m, rpsi3p, rpp, rmm, rnn                    !     -           -           -        -
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+!! DCSE_NEMO: private module variables do not need their own directives file
+!FTRANS en mxln zwall :I :I :z
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -144,4 +167,8 @@
       USE wrk_nemo, ONLY: eps       => wrk_3d_4   ! dissipation rate
       USE wrk_nemo, ONLY: zwall_psi => wrk_3d_5   ! Wall function use in the wb case (ln_sigpsi.AND.ln_crban=T)
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS z_elem_a z_elem_b z_elem_c psi :I :I :z
+!FTRANS eb mxlb shear eps zwall_psi :I :I :z
       !
       INTEGER, INTENT(in) ::   kt ! ocean time step
@@ -169,8 +196,19 @@
             ! 
             ! surface friction 
+#if defined key_z_first
+            ustars2(ji,jj) = rau0r * taum(ji,jj) * tmask_1(ji,jj)
+#else
             ustars2(ji,jj) = rau0r * taum(ji,jj) * tmask(ji,jj,1)
+#endif
             !
             ! bottom friction (explicit before friction)
             ! Note that we chose here not to bound the friction as in dynbfr)
+#if defined key_z_first
+            ztx2 = (  bfrua(ji,jj)  * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj))  )   &
+               & * ( 1._wp - 0.5_wp * umask_1(ji,jj) * umask_1(ji-1,jj)  )
+            zty2 = (  bfrva(ji,jj)  * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1))  )   &
+               & * ( 1._wp - 0.5_wp * vmask_1(ji,jj) * vmask_1(ji,jj-1)  )
+            ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask_1(ji,jj)
+#else
             ztx2 = (  bfrua(ji,jj)  * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj))  )   &
                & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1)  )
@@ -178,4 +216,5 @@
                & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1)  )
             ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)
+#endif
          END DO
       END DO  
@@ -188,7 +227,13 @@
 
       ! Compute shear and dissipation rate
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
                   &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   &
@@ -212,7 +257,13 @@
 
       IF( nn_clos == 0 ) THEN    ! Mellor-Yamada
+#if defined key_z_first
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zup   = mxln(ji,jj,jk) * fsdepw(ji,jj,mbkt(ji,jj)+1)
                   zdown = vkarmn * fsdepw(ji,jj,jk) * ( -fsdepw(ji,jj,jk) + fsdepw(ji,jj,mbkt(ji,jj)+1) )
@@ -237,7 +288,13 @@
       ! Warning : after this step, en : right hand side of the matrix
 
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                !
                ! shear prod. at w-point weightened by mask
@@ -422,21 +479,39 @@
       ! ----------------------------------------------------------
       !
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1                       ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+#else
       DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
+#endif
                z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)
             END DO
          END DO
       END DO
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpk                         ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+#else
       DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
+#endif
                z_elem_a(ji,jj,jk) = en(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)
             END DO
          END DO
       END DO
-      DO jk = jpk-1, 2, -1                         ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = jpk-1, 2, -1                   ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+#else
+      DO jk = jpk-1, 2, -1                         ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
+#endif
                en(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * en(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
             END DO
@@ -455,7 +530,13 @@
       !
       CASE( 0 )               ! k-kl  (Mellor-Yamada)
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   psi(ji,jj,jk)  = en(ji,jj,jk) * mxln(ji,jj,jk)
                END DO
@@ -464,7 +545,13 @@
          !
       CASE( 1 )               ! k-eps
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   psi(ji,jj,jk)  = eps(ji,jj,jk)
                END DO
@@ -473,7 +560,13 @@
          !
       CASE( 2 )               ! k-w
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   psi(ji,jj,jk)  = SQRT( en(ji,jj,jk) ) / ( rc0 * mxln(ji,jj,jk) )
                END DO
@@ -482,7 +575,13 @@
          !
       CASE( 3 )               ! generic
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   psi(ji,jj,jk)  = rc02 * en(ji,jj,jk) * mxln(ji,jj,jk)**rnn 
                END DO
@@ -499,7 +598,13 @@
       ! Warning : after this step, en : right hand side of the matrix
 
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                !
                ! psi / k
@@ -556,5 +661,9 @@
             !                      ! balance between the production and the dissipation terms including the wave effect
             zdep(:,:) = rl_sf * zhsro(:,:)
+#if defined key_z_first
+            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:)
+#else
             psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+#endif
             z_elem_a(:,:,1) = psi(:,:,1)
             z_elem_c(:,:,1) = 0._wp
@@ -565,5 +674,9 @@
             zex2 = (rmm*ra_sf)
             zdep(:,:) = ( (zhsro(:,:) + fsdepw(:,:,2))**zex1 ) / zhsro(:,:)**zex2
+#if defined key_z_first
+            psi (:,:,2) = rsbc_psi1 * ustars2(:,:)**rmm * zdep(:,:) * tmask_1(:,:)
+#else
             psi (:,:,2) = rsbc_psi1 * ustars2(:,:)**rmm * zdep(:,:) * tmask(:,:,1)
+#endif
             z_elem_a(:,:,2) = 0._wp
             z_elem_c(:,:,2) = 0._wp
@@ -575,5 +688,9 @@
             !
             zdep(:,:) = vkarmn * zhsro(:,:)
+#if defined key_z_first
+            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:)
+#else
             psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+#endif
             z_elem_a(:,:,1) = psi(:,:,1)
             z_elem_c(:,:,1) = 0._wp
@@ -582,5 +699,9 @@
             ! one level below
             zdep(:,:) = vkarmn * ( zhsro(:,:) + fsdepw(:,:,2) )
+#if defined key_z_first
+            psi (:,:,2) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:)
+#else
             psi (:,:,2) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+#endif
             z_elem_a(:,:,2) = 0._wp
             z_elem_c(:,:,2) = 0._wp
@@ -594,5 +715,9 @@
             !
             zdep(:,:) = rl_sf * zhsro(:,:)
+#if defined key_z_first
+            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:)
+#else
             psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+#endif
             z_elem_a(:,:,1) = psi(:,:,1)
             z_elem_c(:,:,1) = 0._wp
@@ -612,5 +737,9 @@
             !
             zdep(:,:) = vkarmn * zhsro(:,:)
+#if defined key_z_first
+            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:)
+#else
             psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+#endif
             z_elem_a(:,:,1) = psi(:,:,1)
             z_elem_c(:,:,1) = 0._wp
@@ -693,21 +822,39 @@
       ! ----------------
       !
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1                       ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+#else
       DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
+#endif
                z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)
             END DO
          END DO
       END DO
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpk                         ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+#else
       DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
+#endif
                z_elem_a(ji,jj,jk) = psi(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)
             END DO
          END DO
       END DO
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = jpk-1, 2, -1                   ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+#else
       DO jk = jpk-1, 2, -1                         ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
+#endif
                psi(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * psi(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
             END DO
@@ -721,7 +868,13 @@
       !
       CASE( 0 )               ! k-kl  (Mellor-Yamada)
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / psi(ji,jj,jk)
                END DO
@@ -730,7 +883,13 @@
          !
       CASE( 1 )               ! k-eps
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   eps(ji,jj,jk) = psi(ji,jj,jk)
                END DO
@@ -739,7 +898,13 @@
          !
       CASE( 2 )               ! k-w
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
                END DO
@@ -751,7 +916,13 @@
          zex1  =      ( 1.5_wp + rmm/rnn )
          zex2  = -1._wp / rnn
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+                DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2
                END DO
@@ -763,7 +934,13 @@
       ! Limit dissipation rate under stable stratification
       ! --------------------------------------------------
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1 ! Note that this set boundary conditions on mxln at the same time
+#else
       DO jk = 1, jpkm1 ! Note that this set boundary conditions on mxln at the same time
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
+#endif
                ! limitation
                eps(ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
@@ -783,7 +960,13 @@
       !
       CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ! zcof =  l²/q²
                   zcof = mxlb(ji,jj,jk) * mxlb(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
@@ -804,7 +987,13 @@
          !
       CASE ( 2, 3 )               ! Canuto stability functions
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   ! zcof =  l²/q²
                   zcof = mxlb(ji,jj,jk)*mxlb(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
@@ -850,4 +1039,13 @@
       ! Compute diffusivities/viscosities
       ! The computation below could be restrained to jk=2 to jpkm1 if GOTM style Dirichlet conditions are used
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpk
+#else
+      DO jk = 1, jpk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
       DO jk = 1, jpk
          DO jj = 2, jpjm1
@@ -866,7 +1064,13 @@
       CALL lbc_lnk( avm, 'W', 1. )   ;   CALL lbc_lnk( avt, 'W', 1. )
 
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1      !* vertical eddy viscosity at u- and v-points
+#else
       DO jk = 2, jpkm1            !* vertical eddy viscosity at u- and v-points
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj  ,jk) ) * umask(ji,jj,jk)
                avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji  ,jj+1,jk) ) * vmask(ji,jj,jk)
@@ -887,5 +1091,14 @@
       !
    END SUBROUTINE zdf_gls
-
+      
+   !! * Reset control of array index permutation
+!FTRANS CLEAR
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+!! DCSE_NEMO: private module variables do not need their own directives file
+!FTRANS en mxln zwall :I :I :z
 
    SUBROUTINE zdf_gls_init
@@ -907,6 +1120,6 @@
       USE trazdf_exp
       !
-      INTEGER ::   jk    ! dummy loop indices
-      REAL(wp)::   zcr   ! local scalar
+      INTEGER ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp)::   zcr           ! local scalar
       !!
       NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, &
@@ -1175,4 +1388,16 @@
 
       !                                !* set vertical eddy coef. to the background value
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+               avt (ji,jj,jk) = avtb(jk) * tmask(ji,jj,jk)
+               avm (ji,jj,jk) = avmb(jk) * tmask(ji,jj,jk)
+               avmu(ji,jj,jk) = avmb(jk) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmb(jk) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1, jpk
          avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
@@ -1181,4 +1406,5 @@
          avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
       END DO
+#endif
       !                              
       CALL gls_rst( nit000, 'READ' )   !* read or initialize all required files
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 3211)
@@ -36,4 +36,12 @@
    PUBLIC   zdf_init   ! routine called by opa.F90
    
+   !! * Control permutation of array indices
+#  include "ldftra_oce_ftrans.h90"
+#  include "ldfdyn_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "zdftke_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+#  include "ldfslp_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 3211)
@@ -44,5 +44,8 @@
    LOGICAL , PUBLIC, PARAMETER ::   lk_zdfkpp = .TRUE.    !: KPP vertical mixing flag
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghats    !: non-local scalar mixing term (gamma/<ws>o)
+   !! DCSE_NEMO: ghats does not need to be public
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghats    !: non-local scalar mixing term (gamma/<ws>o)
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghats    !: non-local scalar mixing term (gamma/<ws>o)
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wt0      !: surface temperature flux for non local flux
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ws0      !: surface salinity flux for non local flux
@@ -130,17 +133,35 @@
         
 #if defined key_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rig    !: gradient Richardson number
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rib    !: bulk Richardson number
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   buof   !: buoyancy forcing
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mols   !: moning-Obukhov length scale 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ekdp   !: Ekman depth
+!! DCSE_NEMO: these arrays do not need to be public
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rig    !: gradient Richardson number
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rib    !: bulk Richardson number
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   buof   !: buoyancy forcing
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mols   !: moning-Obukhov length scale 
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ekdp   !: Ekman depth
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rig    !: gradient Richardson number
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rib    !: bulk Richardson number
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   buof   !: buoyancy forcing
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mols   !: moning-Obukhov length scale 
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ekdp   !: Ekman depth
 #endif
 
    INTEGER  ::   jip = 62 , jjp = 111
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+!FTRANS ghats :I :I :z
+!FTRANS etmean eumean evmean :I :I :z
+#if defined key_c1d
+!FTRANS rig rib buof mols :I :I :z
+#endif
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
-#  include  "zdfddm_substitute.h90"
+#  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -210,7 +231,9 @@
       USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace
       USE oce     , zdiffus => sa   ! temp. array for diffusivities use sa as workspace
+!FTRANS zviscos zdiffut zdiffus :I :I :z
 #else
       USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace
       USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace
+!FTRANS zviscos zdiffut :I :I :z
 #endif
       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz
@@ -228,6 +251,10 @@
       USE wrk_nemo, ONLY: zblcm => wrk_xz_1, &   ! Boundary layer 
                           zblct => wrk_xz_2      !  diffusivities/viscosities
+
+      !! DCSE_NEMO: check that wrk_xz_* arrays are being used consistently
+!FTRANS zblcm zblct :I :z
 #if defined key_zdfddm
       USE wrk_nemo, ONLY: zblcs => wrk_xz_3
+!FTRANS zblcs :I :z
 #endif
       !!
@@ -323,7 +350,13 @@
       ! I. Interior diffusivity and viscosity at w points ( T interfaces)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1 
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1 
+#endif
                ! Mixing due to internal waves breaking
                ! -------------------------------------
@@ -523,4 +556,6 @@
          ! Compute the pipe
          ! ---------------------
+
+         !! DCSE_NEMO: is it safe to change the order of these loops?
          DO jk = 2, jpkm1
             DO ji = fs_2, fs_jpim1
@@ -1135,7 +1170,13 @@
          CASE ( 0 )             ! no viscosity and diffusivity smoothing
 
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 2, jpkm1
+#else
             DO jk = 2, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1
+#endif
                      avmu(ji,jj,jk) = ( zviscos(ji,jj,jk) + zviscos(ji+1,jj,jk) ) &
                         &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk)
@@ -1158,7 +1199,13 @@
             !           ( 1/2  1  1/2 )              ( 1/2  1/2 )
   
+#if defined key_z_first
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  DO jk = 2, jpkm1
+#else
             DO jk = 2, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1
+#endif
 
                      avmu(ji,jj,jk) = (      zviscos(ji  ,jj  ,jk) + zviscos(ji+1,jj  ,jk)   &
@@ -1188,4 +1235,30 @@
          END SELECT
 
+#if defined key_z_first
+         !
+         !  Minimum value on the eddy diffusivity
+         ! ----------------------------------------
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+                  avt(ji,jj,jk) = MAX( avt(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
+#if defined key_zdfddm  
+                  avs(ji,jj,jk) = MAX( avs(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
+#endif
+               END DO
+            END DO
+         END DO
+         !
+         ! Minimum value on the eddy viscosity
+         ! ----------------------------------------
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 2, jpkm1
+                  avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), avmb(jk) ) * umask(ji,jj,jk)
+                  avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), avmb(jk) ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 2, jpkm1                       ! vertical slab
             !
@@ -1212,4 +1285,5 @@
             !
          END DO
+#endif
 
          ! Lateral boundary conditions on avt  (sign unchanged)
@@ -1241,4 +1315,15 @@
    END SUBROUTINE zdf_kpp
 
+   !! * Reset control of array index permutation
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+!FTRANS ghats :I :I :z
+!FTRANS etmean eumean evmean :I :I :z
+#if defined key_c1d
+!FTRANS rig rib buof mols :I :I :z
+#endif
 
    SUBROUTINE tra_kpp( kt )
@@ -1252,4 +1337,5 @@
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
       !!----------------------------------------------------------------------
+!FTRANS ztrdt ztrds :I :I :z
       INTEGER, INTENT(in) :: kt
       INTEGER :: ji, jj, jk
@@ -1267,7 +1353,13 @@
 
       ! add non-local temperature and salinity flux ( in convective case only)
+#if defined key_z_first
+      DO jj = 2, jpjm1 
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1
+#endif
                tsa(ji,jj,jk,jp_tem) =  tsa(ji,jj,jk,jp_tem)                      &
                   &                 - (  ghats(ji,jj,jk  ) * avt  (ji,jj,jk  )   & 
@@ -1298,4 +1390,17 @@
 
 #if defined key_top
+
+   !! * Reset control of array index permutation
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+!FTRANS ghats :I :I :z
+!FTRANS etmean eumean evmean :I :I :z
+#if defined key_c1d
+!FTRANS rig rib buof mols :I :I :z
+#endif
+
    !!----------------------------------------------------------------------
    !!   'key_top'                                                TOP models
@@ -1322,4 +1427,5 @@
       REAL(wp) ::   ztra, zflx
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
+!FTRANS ztrtrd :I :I :z
       !!----------------------------------------------------------------------
 
@@ -1336,7 +1442,13 @@
          IF( l_trdtrc )  ztrtrd(:,:,:)  = tra(:,:,:,jn)
          ! add non-local on passive tracer flux ( in convective case only)
+#if defined key_z_first
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1
+#endif
                   ! Surface tracer flux for non-local term 
                   zflx = - ( emps(ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1)
@@ -1372,4 +1484,17 @@
 #endif
 
+   !! * Reset control of array index permutation
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdfddm_ftrans.h90"
+!FTRANS ghats :I :I :z
+!FTRANS etmean eumean evmean :I :I :z
+#if defined key_c1d
+!FTRANS rig rib buof mols :I :I :z
+#endif
+
+
    SUBROUTINE zdf_kpp_init
       !!----------------------------------------------------------------------
@@ -1477,7 +1602,13 @@
          evmean(:,:,:) = 0.e0
          
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
-               DO ji = 2, jpim1   ! vector opt.
+               DO ji = 2, jpim1
+#endif
                   etmean(ji,jj,jk) = tmask(ji,jj,jk)                     &
                   &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
@@ -1503,7 +1634,13 @@
          evmean(:,:,:) = 0.e0
          
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 1, jpkm1
+#else
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   etmean(ji,jj,jk) = tmask(ji, jj,jk)                           &
                      & / MAX( 1., 2.* tmask(ji,jj,jk)                           &
@@ -1534,4 +1671,13 @@
       ! Initialization of vertical eddy coef. to the background value
       ! -------------------------------------------------------------
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            avt (ji,jj,:) = avtb(:) * tmask(ji,jj,:)
+            avmu(ji,jj,:) = avmb(:) * umask(ji,jj,:)
+            avmv(ji,jj,:) = avmb(:) * vmask(ji,jj,:)
+         END DO
+      END DO
+#else
       DO jk = 1, jpk
          avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
@@ -1539,4 +1685,5 @@
          avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
       END DO
+#endif
 
       ! zero the surface flux for non local term and kpp mixed layer depth
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 3211)
@@ -26,4 +26,9 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m]
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
 
    !! * Substitutions
@@ -90,7 +95,13 @@
       nmln(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point
       imld(:,:) = mbkt(:,:) + 1
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = jpkm1, nlb10, -1   ! from the bottom to nlb10
+#else
       DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + zrho_c )   nmln(ji,jj) = jk      ! Mixed layer
                IF( avt (ji,jj,jk) < zavt_c                     )   imld(ji,jj) = jk      ! Turbocline 
@@ -103,6 +114,11 @@
             iiki = imld(ji,jj)
             iikn = nmln(ji,jj)
+#if defined key_z_first
+            hmld (ji,jj) = fsdepw(ji,jj,iiki  ) * tmask_1(ji,jj)    ! Turbocline depth 
+            hmlp (ji,jj) = fsdepw(ji,jj,iikn  ) * tmask_1(ji,jj)    ! Mixed layer depth
+#else
             hmld (ji,jj) = fsdepw(ji,jj,iiki  ) * tmask(ji,jj,1)    ! Turbocline depth 
             hmlp (ji,jj) = fsdepw(ji,jj,iikn  ) * tmask(ji,jj,1)    ! Mixed layer depth
+#endif
             hmlpt(ji,jj) = fsdept(ji,jj,iikn-1)                     ! depth of the last T-point inside the mixed layer
          END DO
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 3211)
@@ -41,4 +41,10 @@
 
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tmric   !: coef. for the horizontal mean at t-point
+
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+!FTRANS tmric :I :I :z
 
    !! * Substitutions
@@ -101,4 +107,7 @@
          CALL ctl_stop('zdf_ric : requested workspace array unavailable')   ;   RETURN
       ENDIF
+
+      !! DCSE_NEMO: To optimise this loop for z_first indexing, make zwx 3-dimensional
+
       !                                                ! ===============
       DO jk = 2, jpkm1                                 ! Horizontal slab
@@ -187,7 +196,13 @@
       IF( zdf_ric_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ric_init : unable to allocate arrays' )
       !
+#if defined key_z_first
+      DO jj = 2, jpj 
+         DO ji = 2, jpi
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk                 ! weighting mean array tmric for 4 T-points
          DO jj = 2, jpj              ! which accounts for coastal boundary conditions            
             DO ji = 2, jpi
+#endif
                tmric(ji,jj,jk) =  tmask(ji,jj,jk)                                  &
                   &            / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
@@ -198,4 +213,15 @@
       tmric(:,1,:) = 0._wp
       !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk           ! Initialization of vertical eddy coef. to the background value
+               avt (ji,jj,jk) = avtb(jk) * tmask(ji,jj,jk)
+               avmu(ji,jj,jk) = avmb(jk) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmb(jk) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 1, jpk                 ! Initialization of vertical eddy coef. to the background value
          avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
@@ -203,4 +229,5 @@
          avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
       END DO
+#endif
       !
    END SUBROUTINE zdf_ric_init
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 3211)
@@ -82,12 +82,25 @@
    REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3)
 
+   !! DCSE_NEMO: en is public because it is used by asmtrj
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2]
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau)
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing length of dissipation
 #if defined key_c1d
    !                                                                        !!** 1D cfg only  **   ('key_c1d')
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_dis, e_mix   !: dissipation and mixing turbulent lengh scales
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers
-#endif
+   !! DCSE_NEMO: these arrays do not need to be public
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_dis, e_mix   !: dissipation and mixing turbulent length scales
+!  REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_dis, e_mix   !: dissipation and mixing turbulent length scales
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers
+#endif
+
+   !! * Control permutation of array indices
+#  include "zdftke_ftrans.h90"
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+!FTRANS dissl e_dis e_mix e_pdl e_ric :I :I :z
 
    !! * Substitutions
@@ -195,4 +208,8 @@
       USE wrk_nemo, ONLY:   zhlc  =>  wrk_2d_1   ! 2D REAL workspace
       USE wrk_nemo, ONLY:   zpelc =>  wrk_3d_1   ! 3D REAL workspace
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zdiag zd_up zd_lw :I :I :z
+!FTRANS zpelc :I :I :z
       !
       INTEGER  ::   ji, jj, jk                      ! dummy loop arguments
@@ -226,5 +243,9 @@
       DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0)
          DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_z_first
+            en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask_1(ji,jj)
+#else
             en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
+#endif
          END DO
       END DO
@@ -260,15 +281,33 @@
          !
          !                        !* total energy produce by LC : cumulative sum over jk
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zpelc(ji,jj,1) =  MAX( rn2b(ji,jj,1), 0._wp ) * fsdepw(ji,jj,1) * fse3w(ji,jj,1)
+               DO jk = 2, jpk
+                  zpelc(ji,jj,jk)  = zpelc(ji,jj,jk-1) + MAX( rn2b(ji,jj,jk), 0._wp ) * fsdepw(ji,jj,jk) * fse3w(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1)
          DO jk = 2, jpk
             zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk)
          END DO
+#endif
          !                        !* finite Langmuir Circulation depth
          zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )
          imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land)
+#if defined key_z_first
+         DO jj = 1, jpj                  ! Last w-level at which zpelc>=0.5*us*us 
+            DO ji = 1, jpi               !      with us=0.016*wind(starting from jpk-1)
+               zus  = zcof * taum(ji,jj)
+               DO jk = jpkm1, 2, -1
+#else
          DO jk = jpkm1, 2, -1
             DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us 
                DO ji = 1, jpi            !      with us=0.016*wind(starting from jpk-1)
                   zus  = zcof * taum(ji,jj)
+#endif
                   IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk
                END DO
@@ -287,4 +326,10 @@
          END DO
          zcof = 0.016 / SQRT( zrhoa * zcdrag )
+#if defined key_z_first
+         DO jj = 2, jpjm1         !* TKE Langmuir circulation source term added to en
+            DO ji = 2, jpim1
+               zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
+               DO jk = 2, jpkm1
+#else
 !CDIR NOVERRCHK
          DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en
@@ -294,4 +339,5 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
+#endif
                   !                                           ! vertical velocity due to LC
                   zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) )
@@ -312,7 +358,15 @@
       !                     ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal
       !
+#if defined key_z_first
+      !* Shear production at uw- and vw-points (energy conserving form)
+             ! here avmu, avmv used as workspace
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 2, jpkm1
+#else
       DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form)
          DO jj = 1, jpj                 ! here avmu, avmv used as workspace
             DO ji = 1, jpi
+#endif
                avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
                   &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   & 
@@ -326,8 +380,15 @@
          END DO
       END DO
-      !
+
+      !
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1     !* Matrix and right hand side in en
+#else
       DO jk = 2, jpkm1           !* Matrix and right hand side in en
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zcof   = zfact1 * tmask(ji,jj,jk)
                zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal
@@ -350,4 +411,27 @@
       END DO
       !                          !* Matrix inversion from level 2 (tke prescribed at level 1)
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+            DO jk = 3, jpkm1
+               zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
+            END DO
+            ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+            zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
+            DO jk = 3, jpkm1
+               zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1)
+            END DO
+            ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+            en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
+            DO jk = jpk-2, 2, -1
+               en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
+            END DO
+            DO jk = 2, jpkm1                       ! set the minimum value of tke
+               en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
          DO jj = 2, jpjm1
@@ -388,4 +472,5 @@
          END DO
       END DO
+#endif
 
       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -393,7 +478,13 @@
       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction)
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
                      &                                               * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk)
@@ -410,4 +501,7 @@
          END DO
       ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability)
+
+         !! DCSE_NEMO: its probably not worth changing the order of these loops for level first indexing,
+         !!            unless we also make zdif a 2-d (jpi,jpj) array
 !CDIR NOVERRCHK
          DO jk = 2, jpkm1
@@ -435,4 +529,12 @@
    END SUBROUTINE tke_tke
 
+   !! * Reset control of array index permutation
+#  include "zdftke_ftrans.h90"
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+!FTRANS dissl e_dis e_mix e_pdl e_ric :I :I :z
 
    SUBROUTINE tke_avn
@@ -472,4 +574,6 @@
       !!----------------------------------------------------------------------
       USE oce, ONLY:   zmpdl => ua , zmxlm => va , zmxld => ta   ! (ua,va,ta) used as workspace
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zmpdl zmxlm zmxld :I :I :z
       !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -491,5 +595,12 @@
          zmxlm(:,:,1) = rn_mxl0
       ENDIF
-      zmxlm(:,:,jpk)  = rmxl_min     ! last level set to the interior minium value
+
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            zmxlm(ji,jj,jpk) = rmxl_min     ! last level set to the interior minium value
+            DO jk = 2, jpkm1        ! interior value : l=sqrt(2*e/n^2)
+#else
+      zmxlm(:,:,jpk)  = rmxl_min    ! last level set to the interior minium value
       !
 !CDIR NOVERRCHK
@@ -499,4 +610,5 @@
 !CDIR NOVERRCHK
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zrn2 = MAX( rn2(ji,jj,jk), rsmall )
                zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
@@ -513,7 +625,13 @@
       !
       CASE ( 0 )           ! bounded by the distance to surface and bottom
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zemxl = MIN( fsdepw(ji,jj,jk), zmxlm(ji,jj,jk),   &
                   &            fsdepw(ji,jj,mbkt(ji,jj)+1) - fsdepw(ji,jj,jk) )
@@ -525,7 +643,13 @@
          !
       CASE ( 1 )           ! bounded by the vertical scale factor
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) )
                   zmxlm(ji,jj,jk) = zemxl
@@ -536,4 +660,18 @@
          !
       CASE ( 2 )           ! |dk[xml]| bounded by e3t :
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1   ! from the surface to the bottom :
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+               END DO
+               DO jk = jpkm1, 2, -1     ! from the bottom to the surface :
+                  zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 2, jpkm1         ! from the surface to the bottom :
             DO jj = 2, jpjm1
@@ -552,6 +690,25 @@
             END DO
          END DO
+#endif
          !
       CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t :
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1         ! from the surface to the bottom : lup
+                  zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+               END DO
+               DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+               END DO
+               DO jk = 2, jpkm1
+                  zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
+                  zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemlm
+                  zmxld(ji,jj,jk) = zemlp
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 2, jpkm1         ! from the surface to the bottom : lup
             DO jj = 2, jpjm1
@@ -581,4 +738,5 @@
             END DO
          END DO
+#endif
          !
       END SELECT
@@ -592,4 +750,9 @@
       !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt)
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1      !* vertical eddy viscosity & diffivity at w-points
+#else
 !CDIR NOVERRCHK
       DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points
@@ -598,4 +761,5 @@
 !CDIR NOVERRCHK
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                zsqen = SQRT( en(ji,jj,jk) )
                zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
@@ -608,7 +772,13 @@
       CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
       !
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 2, jpkm1      !* vertical eddy viscosity at u- and v-points
+#else
       DO jk = 2, jpkm1            !* vertical eddy viscosity at u- and v-points
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj  ,jk) ) * umask(ji,jj,jk)
                avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji  ,jj+1,jk) ) * vmask(ji,jj,jk)
@@ -619,7 +789,13 @@
       !
       IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt
+#if defined key_z_first
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               DO jk = 2, jpkm1
+#else
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+#endif
                   zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
                   !                                          ! shear
@@ -652,4 +828,12 @@
    END SUBROUTINE tke_avn
 
+   !! * Reset control of array index permutation
+#  include "zdftke_ftrans.h90"
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+!FTRANS dissl e_dis e_mix e_pdl e_ric :I :I :z
 
    SUBROUTINE zdf_tke_init
@@ -733,4 +917,14 @@
       ENDIF
       !                               !* set vertical eddy coef. to the background value
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+             avt (ji,jj,:) = avtb(:) * tmask(ji,jj,:)
+             avm (ji,jj,:) = avmb(:) * tmask(ji,jj,:)
+             avmu(ji,jj,:) = avmb(:) * umask(ji,jj,:)
+             avmv(ji,jj,:) = avmb(:) * vmask(ji,jj,:)
+         END DO
+      END DO
+#else
       DO jk = 1, jpk
          avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
@@ -739,4 +933,5 @@
          avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
       END DO
+#endif
       dissl(:,:,:) = 1.e-12_wp
       !                              
@@ -759,5 +954,5 @@
      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
      !
-     INTEGER ::   jit, jk   ! dummy loop indices
+     INTEGER ::   jit, ji, jj, jk   ! dummy loop indices
      INTEGER ::   id1, id2, id3, id4, id5, id6   ! local integers
      !!----------------------------------------------------------------------
@@ -792,4 +987,14 @@
         ELSE                                   !* Start from rest
            en(:,:,:) = rn_emin * tmask(:,:,:)
+#if defined key_z_first
+           DO jj = 1, jpj                           ! set the Kz to the background value
+              DO ji = 1, jpi
+                  avt (ji,jj,:) = avtb(:) * tmask(ji,jj,:)
+                  avm (ji,jj,:) = avmb(:) * tmask(ji,jj,:)
+                  avmu(ji,jj,:) = avmb(:) * umask(ji,jj,:)
+                  avmv(ji,jj,:) = avmb(:) * vmask(ji,jj,:)
+              END DO
+           END DO
+#else
            DO jk = 1, jpk                           ! set the Kz to the background value
               avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
@@ -798,4 +1003,6 @@
               avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
            END DO
+#endif
+
         ENDIF
         !
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke_ftrans.h90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke_ftrans.h90	(revision 3211)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke_ftrans.h90	(revision 3211)
@@ -0,0 +1,20 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  zdftke_ftrans  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Directives to control permutation of array indices for
+   !!   public multi-dimensional arrays with a z-dimension declared in module
+   !!   zdftke.  It should be included wherever the module is used,
+   !!   and updated whenever a new public array is added to the module.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#if defined key_z_first
+!FTRANS assert :z :I
+#else
+!FTRANS assert :I :z
+#endif
+!FTRANS en :I :I :z
Index: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 3187)
+++ branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 3211)
@@ -48,4 +48,10 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   az_tmx     ! coefficient used to evaluate the tidal induced Kz
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+!FTRANS az_tmx :I :I :z
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -110,4 +116,7 @@
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   ztpc         ! scalar workspace
+#if defined key_z_first
+      REAL(wp) ::   ztpc         ! scalar workspace
+#endif
       !!----------------------------------------------------------------------
 
@@ -132,13 +141,30 @@
       END DO
 
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zscal = MIN( zkz(ji,jj), 30./6. )   !kz max = 300 cm2/s
+            DO jk = 2, jpkm1        !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s
+               zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * zscal
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 2, jpkm1              !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s
          zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. )   !kz max = 300 cm2/s
       END DO
+#endif
 
       IF( kt == nit000 ) THEN       !* check at first time-step: diagnose the energy consumed by zav_tide
          ztpc = 0.e0
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+#else
          DO jk= 1, jpk
             DO jj= 1, jpj
                DO ji= 1, jpi
+#endif
                   ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj)   &
                      &         * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
@@ -159,4 +185,23 @@
       !                          !   Update  mixing coefs  !                          
       !                          ! ----------------------- !
+#if defined key_z_first
+      !* update momentum & tracer diffusivity with tidal mixing
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 2, jpkm1 
+               avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk)
+               avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      DO jj = 2, jpjm1
+         DO ji = 2, fpim1
+            DO jk = 2, jpkm1
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji+1,jj  ,jk) ) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji  ,jj+1,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
          avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk)
@@ -169,4 +214,5 @@
          END DO
       END DO
+#endif
       CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! lateral boundary condition
 
@@ -208,7 +254,13 @@
       USE wrk_nemo, ONLY: zempba_3d   => wrk_3d_3, zdn2dz      => wrk_3d_4
       USE wrk_nemo, ONLY: zavt_itf    => wrk_3d_5
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zempba_3d_1 zempba_3d_2 zempba_3d zdn2dz zavt_itf :I :I :z
       !!
       INTEGER , INTENT(in   )                         ::   kt   ! ocean time-step
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pav  ! Tidal mixing coef.
+
+      !! DCSE_NEMO: This style defeats ftrans
+!     REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pav  ! Tidal mixing coef.
+!FTRANS pav :I :I :z
+      REAL(wp), INTENT(inout)            ::   pav(jpi,jpj,jpk)  ! Tidal mixing coef.
       !! 
       INTEGER  ::   ji, jj, jk    ! dummy loop indices
@@ -221,4 +273,17 @@
       END IF
       !                             ! compute the form function using N2 at each time step
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1             
+               zdn2dz     (ji,jj,jk) = rn2(ji,jj,jk) - rn2(ji,jj,jk+1)         ! Vertical profile of dN2/dz
+               zempba_3d_1(ji,jj,jk) = SQRT(  MAX( 0.e0, rn2(ji,jj,jk) )  )    !    -        -    of N
+               zempba_3d_2(ji,jj,jk) =        MAX( 0.e0, rn2(ji,jj,jk) )       !    -        -    of N^2
+            END DO
+            zempba_3d_1(ji,jj,jpk) = 0.e0
+            zempba_3d_2(ji,jj,jpk) = 0.e0
+         END DO
+      END DO
+#else
       zempba_3d_1(:,:,jpk) = 0.e0
       zempba_3d_2(:,:,jpk) = 0.e0
@@ -229,6 +294,20 @@
          zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2
       END DO
-      !
-      zsum (:,:) = 0.e0
+#endif
+      !
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpj
+            zsum1(ji,jj) = 0.e0
+            zsum2(ji,jj) = 0.e0
+            DO jk= 2, jpk
+               zsum1(ji,jj) = zsum1(ji,jj) + zempba_3d_1(ji,jj,jk) * fse3w(ji,jj,jk)
+               zsum2(ji,jj) = zsum2(ji,jj) + zempba_3d_2(ji,jj,jk) * fse3w(ji,jj,jk)                
+            END DO
+            IF( zsum1(ji,jj) /= 0.e0 )   zsum1(ji,jj) = 1.e0 / zsum1(ji,jj)
+            IF( zsum2(ji,jj) /= 0.e0 )   zsum2(ji,jj) = 1.e0 / zsum2(ji,jj)                
+         END DO
+      END DO
+#else
       zsum1(:,:) = 0.e0
       zsum2(:,:) = 0.e0
@@ -243,8 +322,17 @@
          END DO
       END DO
-
-      DO jk= 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
+#endif
+
+      zsum (:,:) = 0.e0
+
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+#else
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+#endif
                zcoef = 0.5 - SIGN( 0.5, zdn2dz(ji,jj,jk) )       ! =0 if dN2/dz > 0, =1 otherwise 
                ztpc  = zempba_3d_1(ji,jj,jk) * zsum1(ji,jj) *        zcoef     &
@@ -254,8 +342,10 @@
                zsum     (ji,jj)    = zsum(ji,jj) + ztpc * fse3w(ji,jj,jk)
             END DO
+#if !defined key_z_first
          END DO
        END DO
        DO jj = 1, jpj
           DO ji = 1, jpi
+#endif
              IF( zsum(ji,jj) > 0.e0 )   zsum(ji,jj) = 1.e0 / zsum(ji,jj)                
           END DO
@@ -264,13 +354,36 @@
       !                             ! first estimation bounded by 10 cm2/s (with n2 bounded by rn_n2min) 
       zcoef = rn_tfe_itf / ( rn_tfe * rau0 )
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+                zavt_itf(ji,jj,jk) = MIN(  10.e-4, zcoef * en_tmx(ji,jj) * zsum(ji,jj) * zempba_3d(ji,jj,jk)   &
+            &                                             / MAX( rn_n2min, rn2(ji,jj,jk) ) * tmask(ji,jj,jk)  )
+             END DO
+         END DO
+      END DO           
+#else
       DO jk = 1, jpk
          zavt_itf(:,:,jk) = MIN(  10.e-4, zcoef * en_tmx(:,:) * zsum(:,:) * zempba_3d(:,:,jk)   &
             &                                      / MAX( rn_n2min, rn2(:,:,jk) ) * tmask(:,:,jk)  )
       END DO           
-
+#endif
+
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zkz(ji,jj) = 0.e0       ! Associated potential energy consummed over the whole water column
+            DO jk = 2, jpkm1
+               zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk)   &
+                  &                     * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#else
       zkz(:,:) = 0.e0               ! Associated potential energy consummed over the whole water column
       DO jk = 2, jpkm1
          zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * tmask(:,:,jk)
       END DO
+#endif
 
       DO jj = 1, jpj                ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
@@ -280,13 +393,30 @@
       END DO
 
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zcoef = MIN( zkz(:,:), 120./10. )                              ! kz max = 120 cm2/s
+            DO jk = 2, jpkm1        ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s
+               zavt_itf(ji,jj,jk) = zavt_itf(ji,jj,jk) * zcoef
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 2, jpkm1              ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s
          zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. )   ! kz max = 120 cm2/s
       END DO
-
-      IF( kt == nit000 ) THEN       ! diagnose the nergy consumed by zavt_itf
+#endif
+
+      IF( kt == nit000 ) THEN       ! diagnose the energy consumed by zavt_itf
          ztpc = 0.e0
-         DO jk= 1, jpk
-            DO jj= 1, jpj
-               DO ji= 1, jpi
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+#else
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+#endif
                   ztpc = ztpc + e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   &
                      &                     * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
@@ -299,8 +429,19 @@
 
       !                             ! Update pav with the ITF mixing coefficient
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 2, jpkm1
+               pav(ji,jj,jk) = pav     (ji,jj,jk) * ( 1.e0 - mask_itf(ji,jj) )   &
+            &                + zavt_itf(ji,jj,jk) *          mask_itf(ji,jj) 
+            END DO
+         END DO
+      END DO
+#else
       DO jk = 2, jpkm1
          pav(:,:,jk) = pav     (:,:,jk) * ( 1.e0 - mask_itf(:,:) )   &
             &        + zavt_itf(:,:,jk) *          mask_itf(:,:) 
       END DO
+#endif
       !
       IF( wrk_not_released(2, 2,3,4,5) .OR. &
@@ -311,4 +452,9 @@
    END SUBROUTINE tmx_itf
 
+   !! * Reset control of array index permutation
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "zdf_oce_ftrans.h90"
+!FTRANS az_tmx :I :I :z
 
    SUBROUTINE zdf_tmx_init
@@ -354,8 +500,16 @@
       USE wrk_nemo, ONLY:   zhdep    =>  wrk_2d_5   ! Ocean depth 
       USE wrk_nemo, ONLY:   zpc      =>  wrk_3d_1   ! power consumption
+
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS zpc :I :I :z
+
       !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       INTEGER  ::   inum         ! local integer
       REAL(wp) ::   ztpc, ze_z   ! local scalars
+#if defined key_z_first
+      REAL(wp) ::   zcoef        ! local scalar
+#endif
+
       !!
       NAMELIST/namzdf_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf
@@ -414,7 +568,13 @@
          END DO
       END DO
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk= 1, jpk           ! complete with the level-dependent part
+#else
       DO jk= 1, jpk                 ! complete with the level-dependent part
          DO jj = 1, jpj
             DO ji = 1, jpi
+#endif
                az_tmx(ji,jj,jk) = zfact(ji,jj) * EXP( -( zhdep(ji,jj)-fsdepw(ji,jj,jk) ) / rn_htmx ) * tmask(ji,jj,jk)
             END DO
@@ -426,14 +586,32 @@
          ! Total power consumption due to vertical mixing
          ! zpc = rau0 * 1/rn_me * rn2 * zav_tide
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zav_tide(ji,jj,1) = 0.e0
+               DO jk = 2, jpkm1
+                  zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) )
+               END DO
+               zav_tide(ji,jj,jpk) = 0.e0
+            END DO
+         END DO
+#else
          zav_tide(:,:,:) = 0.e0
          DO jk = 2, jpkm1
             zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) )
          END DO
+#endif
 
          ztpc = 0.e0
          zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:)
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk= 2, jpkm1
+#else
          DO jk= 2, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
@@ -448,11 +626,19 @@
          ! control print 2
          zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 )   
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zkz(ji,jj) = 0.e0
+               DO jk = 2, jpkm1
+#else
          zkz(:,:) = 0.e0
          DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk)* tmask(ji,jj,jk)
-            END DO
-         END DO
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+#endif
+                  zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk)   &
+                     &                     * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk)* tmask(ji,jj,jk)
+               END DO
+            END DO
          END DO
          ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz
@@ -468,18 +654,35 @@
             DO ji = 1, jpi
                IF( zkz(ji,jj) /= 0.e0 )   THEN
-                   ztpc = Min( zkz(ji,jj), ztpc)
+                   ztpc = MIN( zkz(ji,jj), ztpc)
                ENDIF
             END DO
          END DO
-         WRITE(numout,*) '          Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) )
-
+         WRITE(numout,*) '          Min de zkz ', ztpc, ' Max = ', MAXVAL(zkz(:,:) )
+
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcoef = MIN( zkz(ji,jj), 30./6. )                            !kz max = 300 cm2/s
+               DO jk = 2, jpkm1
+                  zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * zcoef
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 2, jpkm1
             zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. )   !kz max = 300 cm2/s
          END DO
+#endif
          ztpc = 0.e0
-         zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:)
+         zpc(:,:,:) = MAX(0.e0,rn2(:,:,:)) * zav_tide(:,:,:)
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk= 1, jpk
+#else
          DO jk= 1, jpk
             DO jj = 1, jpj
                DO ji = 1, jpi
+#endif
                   ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
