Index: /branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/OPATAM_SRC/TRA/zpshde_tam.F90
===================================================================
--- /branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/OPATAM_SRC/TRA/zpshde_tam.F90	(revision 4593)
+++ /branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/OPATAM_SRC/TRA/zpshde_tam.F90	(revision 4594)
@@ -35,5 +35,5 @@
    PUBLIC zps_hde_tan      ! routine called by step_tam.F90
    PUBLIC zps_hde_adj      ! routine called by step_tam.F90
-   !PUBLIC zps_hde_adj_tst  ! routine called by tst.F90
+   PUBLIC zps_hde_adj_tst  ! routine called by tst.F90
 
    !! * Substitutions
@@ -104,5 +104,5 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in ) ::   &
          pta, pta_tl            ! 3D T, S and rd direct fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ), OPTIONAL ::   &
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ), OPTIONAL ::   &
          prd_tl
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ), OPTIONAL ::   &
@@ -261,5 +261,5 @@
    END SUBROUTINE zps_hde_tan
 
-   SUBROUTINE zps_hde_adj ( kt, kjpt, pta, pgtu, pgtv,       &
+   SUBROUTINE zps_hde_adj ( kt, kjpt, pta,       &
       &                      pta_ad,  prd_ad,    &
       &                      pgtu_ad, pgru_ad,   &
@@ -325,5 +325,5 @@
          prd_ad                                              ! 3D T, S and rd tangent fields
       REAL(wp), DIMENSION(jpi,jpj,kjpt), INTENT( inout ), OPTIONAL ::   &
-         pgtu, pgtv, pgtu_ad, pgtv_ad                                     ! 3D T, S and rd tangent fields
+         pgtu_ad, pgtv_ad                                     ! 3D T, S and rd tangent fields
       REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ), OPTIONAL ::   &
          pgru_ad,                               &  ! horizontal grad. of T, S and rd at u-
@@ -368,12 +368,8 @@
                   ! interpolated values of tracers
                   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
-                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
                ELSE                           ! case 2
                   zmaxu = -ze3wu / fse3w(ji,jj,iku)
                   ! interpolated values of tracers
                   zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
-                  ! gradient of tracers
-                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
                ENDIF
                !
@@ -383,12 +379,8 @@
                   ! interpolated values of tracers
                   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
-                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
                ELSE                           ! case 2
                   zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
                   ! interpolated values of tracers
                   ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
-                  ! gradient of tracers
-                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
                ENDIF
 # if ! defined key_vectopt_loop
@@ -396,5 +388,4 @@
 # endif
          END DO
-         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
          !
       END DO
@@ -566,209 +557,196 @@
       !
    END SUBROUTINE zps_hde_adj
-   !SUBROUTINE zps_hde_adj_tst( kumadt )
-      !!!-----------------------------------------------------------------------
-      !!!
-      !!!                  ***  ROUTINE zps_hde_adj_tst ***
-      !!!
-      !!! ** Purpose : Test the adjoint routine.
-      !!!
-      !!! ** Method  : Verify the scalar product
-      !!!
-      !!!                 ( L dx )^T W dy  =  dx^T L^T W dy
-      !!!
-      !!!              where  L   = tangent routine
-      !!!                     L^T = adjoint routine
-      !!!                     W   = diagonal matrix of scale factors
-      !!!                     dx  = input perturbation (random field)
-      !!!                     dy  = L dx
-      !!!
-      !!!
-      !!! History :
-      !!!        ! 08-08 (A. Vidard)
-      !!!-----------------------------------------------------------------------
-      !!! * Modules used
-
-      !!! * Arguments
-      !INTEGER, INTENT(IN) :: &
-         !& kumadt             ! Output unit
-
-      !INTEGER :: &
-         !& ji,    &        ! dummy loop indices
-         !& jj,    &
-         !& jk,    &
-         !& kt,    &
-         !& jn
-
-      !!! * Local declarations
-      !REAL(KIND=wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
-         !& zts,         & ! Direct field : temperature
-         !& zts_tlin,    & ! Tangent input: temperature
-         !& zts_adout,   & ! Adjoint output: temperature
-         !& zats           ! 3D random field for t
-
-      !REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: &
-         !& zgtu_tlout,   & ! Tangent output: horizontal gradient
-         !& zgtv_tlout,   & ! Tangent output: horizontal gradient
-         !& zrd_adout,    & ! Adjoint output:
-         !& zar,          & ! 3D random field for rd
-         !& zrd_tlin,     & ! Tangent input:
-         !& zgtu_adin,    & ! Adjoint input : horizontal gradient
-         !& zgtv_adin       ! Adjoint input : horizontal gradient
-
-      !REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
-         !& zgru_tlout,   & ! Tangent output: horizontal gradient
-         !& zgrv_tlout,   & ! Tangent output: horizontal gradient
-         !& zgru_adin,    & ! Adjoint input : horizontal gradient
-         !& zgrv_adin       ! Adjoint input : horizontal gradient
-
-      !REAL(KIND=wp) :: &
-                           !! random field standard deviation for:
-         !& zsp1,         & ! scalar product involving the tangent routine
-         !& zsp1_1,       & !   scalar product components
-         !& zsp1_2,       &
-         !& zsp1_3,       & !   scalar product components
-         !& zsp1_4,       &
-         !& zsp1_5,       & !   scalar product components
-         !& zsp1_6,       &
-         !& zsp2,         & ! scalar product involving the adjoint routine
-         !& zsp2_1,       & !   scalar product components
-         !& zsp2_2,       &
-         !& zsp2_3
-      !CHARACTER (LEN=14) :: &
-         !& cl_name
-
-      !kt = nit000
-      !! Allocate memory
-      !ALLOCATE( &
-         !& zts(jpi,jpj,jpk,jpts),         &
-         !& zts_tlin(jpi,jpj,jpk,jpts),    &
-         !& zrd_tlin(jpi,jpj,jpk),     &
-         !& zts_adout(jpi,jpj,jpk,jpts),   &
-         !& zrd_adout(jpi,jpj,jpk),    &
-         !& zar(jpi,jpj,jpk),          &
-         !& zats(jpi,jpj,jpk,jpts),          &
-         !& zgtu_tlout(jpi,jpj,jpts),       &
-         !& zgtv_tlout(jpi,jpj,jpts),       &
-         !& zgru_tlout(jpi,jpj),       &
-         !& zgrv_tlout(jpi,jpj),       &
-         !& zgtu_adin(jpi,jpj,jpts),        &
-         !& zgtv_adin(jpi,jpj,jpts),        &
-         !& zgru_adin(jpi,jpj),        &
-         !& zgrv_adin(jpi,jpj)         &
-         !& )
-      !! Initialize random field standard deviationsthe reference state
-      !zts = tsn(:,:,:,:)
-
-      !!=============================================================
-      !! 1) dx = ( T ) and dy = ( T )
-      !!=============================================================
-
-      !!--------------------------------------------------------------------
-      !! Reset the tangent and adjoint variables
-      !!--------------------------------------------------------------------
-      !zts_tlin(:,:,:,:)  = 0.0_wp
-      !zrd_tlin(:,:,:)   = 0.0_wp
-      !zts_adout(:,:,:,:) = 0.0_wp
-      !zrd_adout(:,:,:)  = 0.0_wp
-      !zgtu_tlout(:,:,:)   = 0.0_wp
-      !zgtv_tlout(:,:,:)   = 0.0_wp
-      !zgru_tlout(:,:)   = 0.0_wp
-      !zgrv_tlout(:,:)   = 0.0_wp
-      !zgtu_adin(:,:,:)    = 0.0_wp
-      !zgtv_adin(:,:,:)    = 0.0_wp
-      !zgru_adin(:,:)    = 0.0_wp
-      !zgrv_adin(:,:)    = 0.0_wp
-
-      !!--------------------------------------------------------------------
-      !! Initialize the tangent input with random noise: dx
-      !!--------------------------------------------------------------------
-      !DO jn = 1, jpts
-         !CALL grid_random(  zats(:,:,:,jn), 'T', 0.0_wp, stdt )
-      !END DO
-      !CALL grid_random(  zar, 'T', 0.0_wp, stdr )
-
-      !zts_tlin(:,:,:,:) = zats(:,:,:,:)
-      !zrd_tlin(:,:,:) = zar(:,:,:)
-      !CALL zps_hde_tan ( nit000, jpts, zts,           &
-         !&                   zts_tlin , zrd_tlin  ,   &
-         !&                   zgtu_tlout, zgru_tlout,  &
-         !&                   zgtv_tlout, zgrv_tlout   )
-      !DO jn = 1, jpts
-         !DO jj = nldj, nlej
-            !DO ji = nldi, nlei
-               !jk = mbku(ji,jj)
-               !zgtu_adin(ji,jj,jn) = zgtu_tlout(ji,jj,jn) &
-                  !&             * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) &
-                  !&             * umask(ji,jj,jk)
-               !jk = mbkv(ji,jj)
-               !zgtv_adin(ji,jj,jn) = zgtv_tlout(ji,jj,jn) &
-                  !&             * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) &
-                  !&             * vmask(ji,jj,jk)
-            !END DO
-         !END DO
-      !END DO
-      !DO jj = nldj, nlej
-         !DO ji = nldi, nlei
-            !jk = mbku(ji,jj)
-            !zgru_adin(ji,jj) = zgru_tlout(ji,jj) &
-               !&             * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) &
-               !&             * umask(ji,jj,jk)
-            !jk = mbkv(ji,jj)
-            !zgrv_adin(ji,jj) = zgrv_tlout(ji,jj) &
-               !&             * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) &
-               !&             * vmask(ji,jj,jk)
-         !END DO
-      !END DO
+      SUBROUTINE zps_hde_adj_tst( kumadt )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                  ***  ROUTINE zps_hde_adj_tst ***
+      !!
+      !! ** Purpose : Test the adjoint routine.
+      !!
+      !! ** Method  : Verify the scalar product
+      !!
+      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
+      !!
+      !!              where  L   = tangent routine
+      !!                     L^T = adjoint routine
+      !!                     W   = diagonal matrix of scale factors
+      !!                     dx  = input perturbation (random field)
+      !!                     dy  = L dx
+      !!
+      !!
+      !! History :
+      !!        ! 08-08 (A. Vidard)
+      !!-----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kumadt             ! Output unit
+
+      INTEGER :: &
+         & ji,    &        ! dummy loop indices
+         & jj,    &
+         & jk,    &
+         & kt,    &
+         & jn
+
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(:,:,:,:), POINTER :: &
+         & zts,         & ! Direct field : temperature
+         & zts_tlin,    & ! Tangent input: temperature
+         & zts_adout,   & ! Adjoint output: temperature
+         & zats           ! 3D random field for t
+
+      REAL(KIND=wp), DIMENSION(:,:,:), POINTER :: &
+         & zgtu_tlout,   & ! Tangent output: horizontal gradient
+         & zgtv_tlout,   & ! Tangent output: horizontal gradient
+         & zrd_adout,    & ! Adjoint output:
+         & zar,          & ! 3D random field for rd
+         & zrd_tlin,     & ! Tangent input:
+         & zgtu_adin,    & ! Adjoint input : horizontal gradient
+         & zgtv_adin       ! Adjoint input : horizontal gradient
+
+      REAL(KIND=wp), DIMENSION(:,:), POINTER :: &
+         & zgru_tlout,   & ! Tangent output: horizontal gradient
+         & zgrv_tlout,   & ! Tangent output: horizontal gradient
+         & zgru_adin,    & ! Adjoint input : horizontal gradient
+         & zgrv_adin       ! Adjoint input : horizontal gradient
+
+      REAL(KIND=wp) :: &
+                           ! random field standard deviation for:
+         & zsp1,         & ! scalar product involving the tangent routine
+         & zsp1_1,       & !   scalar product components
+         & zsp1_2,       &
+         & zsp1_3,       & !   scalar product components
+         & zsp1_4,       &
+         & zsp1_5,       & !   scalar product components
+         & zsp1_6,       &
+         & zsp2,         & ! scalar product involving the adjoint routine
+         & zsp2_1,       & !   scalar product components
+         & zsp2_2,       &
+         & zsp2_3
+      CHARACTER (LEN=14) :: &
+         & cl_name
+
+      kt = nit000
+      ! Allocate memory
+      CALL wrk_alloc(jpi, jpj, jpk, jpts, zts, zts_tlin,zts_adout, zats )
+
+      CALL wrk_alloc(jpi, jpj, jpts, zgtu_tlout, zgtv_tlout, zgtu_adin, zgtv_adin )
+
+      CALL wrk_alloc(jpi, jpj, jpk , zrd_adout, zrd_tlin, zar )
+
+      CALL wrk_alloc(jpi, jpj, zgru_tlout, zgrv_tlout, zgru_adin, zgrv_adin )
+
+      ! Initialize random field standard deviationsthe reference state
+      zts = tsn(:,:,:,:)
+
+      !=============================================================
+      ! 1) dx = ( T ) and dy = ( T )
+      !=============================================================
+
+      !--------------------------------------------------------------------
+      ! Reset the tangent and adjoint variables
+      !--------------------------------------------------------------------
+      zts_tlin(:,:,:,:)  = 0.0_wp
+      zrd_tlin(:,:,:)   = 0.0_wp
+      zts_adout(:,:,:,:) = 0.0_wp
+      zrd_adout(:,:,:)  = 0.0_wp
+      zgtu_tlout(:,:,:)   = 0.0_wp
+      zgtv_tlout(:,:,:)   = 0.0_wp
+      zgru_tlout(:,:)   = 0.0_wp
+      zgrv_tlout(:,:)   = 0.0_wp
+      zgtu_adin(:,:,:)    = 0.0_wp
+      zgtv_adin(:,:,:)    = 0.0_wp
+      zgru_adin(:,:)    = 0.0_wp
+      zgrv_adin(:,:)    = 0.0_wp
+
+      !--------------------------------------------------------------------
+      ! Initialize the tangent input with random noise: dx
+      !--------------------------------------------------------------------
+      DO jn = 1, jpts
+         CALL grid_random(  zats(:,:,:,jn), 'T', 0.0_wp, stdt )
+      END DO
+      CALL grid_random(  zar, 'T', 0.0_wp, stdr )
+
+      DO jj = nldj, nlej
+         DO ji = nldi, nlei
+            zts_tlin(ji,jj,:,:) = zats(ji,jj,:,:)
+            zrd_tlin(ji,jj,:)   = zar (ji,jj,:)
+         END DO
+      END DO
+
+      CALL zps_hde_tan ( nit000, jpts, zts,           &
+         &                   zts_tlin , zrd_tlin  ,   &
+         &                   zgtu_tlout, zgru_tlout,  &
+         &                   zgtv_tlout, zgrv_tlout   )
+
+      DO jn = 1, jpts
+         DO jj = nldj, nlej
+            DO ji = nldi, nlei
+               jk = mbku(ji,jj)
+               zgtu_adin(ji,jj,jn) = zgtu_tlout(ji,jj,jn) &
+                  &             * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) &
+                  &             * umask(ji,jj,jk)
+               jk = mbkv(ji,jj)
+               zgtv_adin(ji,jj,jn) = zgtv_tlout(ji,jj,jn) &
+                  &             * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) &
+                  &             * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      DO jj = nldj, nlej
+         DO ji = nldi, nlei
+            jk = mbku(ji,jj)
+            zgru_adin(ji,jj) = zgru_tlout(ji,jj) &
+               &             * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) &
+               &             * umask(ji,jj,jk)
+            jk = mbkv(ji,jj)
+            zgrv_adin(ji,jj) = zgrv_tlout(ji,jj) &
+               &             * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) &
+               &             * vmask(ji,jj,jk)
+         END DO
+      END DO
       !!--------------------------------------------------------------------
       !! Compute the scalar product: ( L dx )^T W dy
       !!--------------------------------------------------------------------
 
-      !zsp1_1 = DOT_PRODUCT( zgtu_adin(:,:,jp_tem), zgtu_tlout(:,:,jp_tem) )
-      !zsp1_2 = DOT_PRODUCT( zgtu_adin(:,:,jp_sal), zgtu_tlout(:,:,jp_sal) )
-      !zsp1_3 = DOT_PRODUCT( zgru_adin, zgru_tlout )
-      !zsp1_4 = DOT_PRODUCT( zgtv_adin(:,:,jp_tem), zgtv_tlout(:,:,jp_tem) )
-      !zsp1_5 = DOT_PRODUCT( zgtv_adin(:,:,jp_sal), zgtv_tlout(:,:,jp_sal) )
-      !zsp1_6 = DOT_PRODUCT( zgrv_adin, zgrv_tlout )
-      !zsp1 = zsp1_1 + zsp1_2 + zsp1_3 + zsp1_4 + zsp1_5 + zsp1_6
-
-
-      !!--------------------------------------------------------------------
-      !! Call the adjoint routine: dx^* = L^T dy^*
-      !!--------------------------------------------------------------------
-      !CALL zps_hde_adj ( kt, jpts, zts, gtsu, gtsv ,   &
-         !&                   tsa_ad,   ,   &
-         !&                   zgtu_adin , zgru_adin ,   &
-         !&                   zgtv_adin , zgrv_adin     )
-
-      !zsp2_1 = DOT_PRODUCT( zts_tlin(:,:,:,jp_tem), zts_adout(:,:,:,jp_tem) )
-      !zsp2_2 = DOT_PRODUCT( zts_tlin(:,:,:,jp_sal), zts_adout(:,:,:,jp_sal) )
-      !zsp2_3 = DOT_PRODUCT( zrd_tlin , zrd_adout  )
-      !zsp2   = zsp2_1 + zsp2_2 + zsp2_3
-
-      !! Compare the scalar products
-
-      !cl_name = 'zps_hde_adj   '
-      !CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
-
-      !! Deallocate memory
-      !DEALLOCATE( &
-         !& zts,         &
-         !& zts_tlin,    &
-         !& zrd_tlin,     &
-         !& zts_adout,   &
-         !& zrd_adout,    &
-         !& zar,          &
-         !& zats,          &
-         !& zgtu_tlout,   &
-         !& zgtv_tlout,   &
-         !& zgru_tlout,   &
-         !& zgrv_tlout,   &
-         !& zgtu_adin,    &
-         !& zgtv_adin,    &
-         !& zgru_adin,    &
-         !& zgrv_adin     &
-         !& )
-
-   !END SUBROUTINE zps_hde_adj_tst
+      zsp1_1 = DOT_PRODUCT( zgtu_adin(:,:,jp_tem), zgtu_tlout(:,:,jp_tem) )
+      zsp1_2 = DOT_PRODUCT( zgtu_adin(:,:,jp_sal), zgtu_tlout(:,:,jp_sal) )
+      zsp1_3 = DOT_PRODUCT( zgru_adin, zgru_tlout )
+      zsp1_4 = DOT_PRODUCT( zgtv_adin(:,:,jp_tem), zgtv_tlout(:,:,jp_tem) )
+      zsp1_5 = DOT_PRODUCT( zgtv_adin(:,:,jp_sal), zgtv_tlout(:,:,jp_sal) )
+      zsp1_6 = DOT_PRODUCT( zgrv_adin, zgrv_tlout )
+      zsp1 = zsp1_1 + zsp1_2 + zsp1_3 + zsp1_4 + zsp1_5 + zsp1_6
+
+
+      !--------------------------------------------------------------------
+      ! Call the adjoint routine: dx^* = L^T dy^*
+      !--------------------------------------------------------------------
+      CALL zps_hde_adj ( kt, jpts, zts ,   &
+         &                   zts_adout , zrd_adout ,   &
+         &                   zgtu_adin , zgru_adin ,   &
+         &                   zgtv_adin , zgrv_adin     )
+
+      zsp2_1 = DOT_PRODUCT( zts_tlin(:,:,:,jp_tem), zts_adout(:,:,:,jp_tem) )
+      zsp2_2 = DOT_PRODUCT( zts_tlin(:,:,:,jp_sal), zts_adout(:,:,:,jp_sal) )
+      zsp2_3 = DOT_PRODUCT( zrd_tlin , zrd_adout  )
+      zsp2   = zsp2_1 + zsp2_2 + zsp2_3
+
+      ! Compare the scalar products
+
+      cl_name = 'zps_hde_adj   '
+      CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
+
+      ! Deallocate memory
+      CALL wrk_dealloc(jpi, jpj, jpk, jpts, zts, zts_tlin,zts_adout, zats )
+
+      CALL wrk_dealloc(jpi, jpj, jpts, zgtu_tlout, zgtv_tlout, zgtu_adin, zgtv_adin )
+
+      CALL wrk_dealloc(jpi, jpj, jpk , zrd_adout, zrd_tlin, zar )
+
+      CALL wrk_dealloc(jpi, jpj, zgru_tlout, zgrv_tlout, zgru_adin, zgrv_adin )
+     
+
+   END SUBROUTINE zps_hde_adj_tst
 #endif
 END MODULE zpshde_tam
