Bug in hpg_prj (dynhpg.F90) reported by hliu

[acc]

As reported:
Revision: 5212
Author: hliu
Date: 2015-04-15 13:14:00 +0200 (Wed, 15 Apr 2015)
Log Message:

---

A serious mistake in dynhpg: hpg_prj, which should also be corrected in v3.6 main trunk

Modified Paths:
--------------
    branches/2015/dev_r4826_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

Modified: branches/2015/dev_r4826_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- branches/2015/dev_r4826_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	2015-04-15 10:10:56 UTC (rev 5211)
+++ branches/2015/dev_r4826_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	2015-04-15 11:14:00 UTC (rev 5212)
@@ -793,6 +793,7 @@
       REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   sshu_n, sshv_n
       REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter
       !!----------------------------------------------------------------------
       !
@@ -799,6 +800,7 @@
       !
       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
       CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh )
+      CALL wrk_alloc( jpi,jpj, sshu_n, sshv_n )
       IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
       !
       IF( kt == nit000 ) THEN
@@ -909,10 +911,31 @@
       END DO
       ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1)
+
+      ! The following modification "sshu_n -> sshn" is a big mistake, this
+      ! should never happen here, remember to correct this in NEMO v3.6
+      ! trunk.  H.L.
+
+      !prepare sshu_n and sshv_n
+      DO jj = 1, jpjm1
+        DO ji = 1, jpim1
+          sshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * &
+                        & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp
+          sshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * &
+                        & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp
+        END DO
+      END DO
+
+      CALL lbc_lnk (sshu_n, 'U', 1)
+      CALL lbc_lnk (sshv_n, 'V', 1)
+
       DO jj = 2, jpjm1
         DO ji = 2, jpim1
-          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshu_n for ztilde compilation
-          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshv_n for ztilde compilation
+          !zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshu_n for ztilde compilation
+          !zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshv_n for ztilde compilation
+
+          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshu_n(ji,jj) * znad)
+          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshv_n(ji,jj) * znad)
         END DO
       END DO
@@ -1081,6 +1104,7 @@
       !
       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
       CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh )
+      CALL wrk_dealloc( jpi,jpj, sshu_n, sshv_n )
       IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
       !
    END SUBROUTINE hpg_prj

Corrected in trunk at rev 5224 as follows:

Index: NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90 (revision 5223)
+++ NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90 (working copy)
@@ -955,10 +955,12 @@
       REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zsshu_n, zsshv_n
       !!----------------------------------------------------------------------
       !
       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
       CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh )
+      CALL wrk_alloc( jpi,jpj, zsshu_n, zsshv_n )
       !
       IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
@@ -1039,13 +1041,24 @@
       END DO
 
       ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1)
+
+      ! Prepare zsshu_n and zsshv_n
       DO jj = 2, jpjm1
         DO ji = 2, jpim1
-          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshu_n for ztilde compilation
-          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshv_n for ztilde compilation
+          zsshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * &
+                         & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
+          zsshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * &
+                         & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
         END DO
       END DO
 
+      DO jj = 2, jpjm1
+        DO ji = 2, jpim1
+          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - zsshu_n(ji,jj) * znad) 
+          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - zsshv_n(ji,jj) * znad)
+        END DO
+      END DO
+
       DO jk = 2, jpkm1
         DO jj = 2, jpjm1
           DO ji = 2, jpim1
@@ -1204,6 +1217,7 @@
       !
       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
       CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh )
+      CALL wrk_dealloc( jpi,jpj, zsshu_n, zsshv_n )
       !
    END SUBROUTINE hpg_prj

The differences being the removal of redundant comments and lbc_lnk calls and the correct naming convention for local variables.