Changeset 15271 for NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/domwri.f90

Timestamp:

2021-09-20T11:12:08+02:00 (17 months ago)

Author:

dbruciaferri

Message:

rewriting saw tooth dignostic

File:

• NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/domwri.f90 (modified) (4 diffs)

NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/domwri.f90

@@ -16 +16 @@
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain
+   USE mes, ONLY : ln_loc_mes
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O library
@@ -554 +555 @@
       REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! saw-tooth metric
       !
-      INTEGER                                         ::   ji, jj, k1, k2
+      INTEGER                                         ::   ji, jj, kk, km1, kp1
+      REAL(wp)                                        ::   dm1, dp1
       REAL(wp), DIMENSION(4)                          ::   zr1
       REAL(wp), DIMENSION(jpi,jpj)                    ::   zx1
@@ -564 +566 @@
          DO jj = 2, jpjm1
             ! Avoiding coastal points
-            IF ( ( + tmask(ji-1,jj+1) + tmask(ji,jj+1) + tmask(ji+1,jj+1)             &
-               &   + tmask(ji-1,jj  )                  + tmask(ji+1,jj  )             &
-               &   + tmask(ji-1,jj-1) + tmask(ji,jj+1) + tmask(ji+1,jj-1) ) == 8._wp ) THEN
+            IF ( ( + ssmask(ji-1,jj+1) + ssmask(ji,jj+1) + ssmask(ji+1,jj+1)             &
+               &   + ssmask(ji-1,jj  )                   + ssmask(ji+1,jj  )             &
+               &   + ssmask(ji-1,jj-1) + ssmask(ji,jj+1) + ssmask(ji+1,jj-1) ) == 8._wp ) THEN
                !
                zr1(:) = 0._wp   
-               k1 = mbkt(ji,jj) 
-               ! i-1
-               k2 = mbkt(ji-1,jj)
-               IF ( ( (k1 > k2) .AND. (gdepw_0(ji,jj,jpk) < gdepw_0(ji-1,jj,jpk)) ) .OR. &
-                  & ( (k1 < k2) .AND. (gdepw_0(ji,jj,jpk) > gdepw_0(ji-1,jj,jpk)) ) ) THEN 
-                  zr1(1) = ABS( mbkt(ji,jj) - mbkt(ji-1,jj) ) * umask(ji-1,jj)
+               kk = mbkt(ji,jj)
+               !
+               ! i-direction
+               km1 = mbkt(ji-1,jj) 
+               kp1 = mbkt(ji+1,jj)
+               dm1 = gdept_0(ji-1, jj, km1) - gdept_0(ji, jj, kk)
+               dp1 = gdept_0(ji+1, jj, kp1) - gdept_0(ji, jj, kk)
+               IF ( (dp1 * dm1) > 0. ) THEN
+                  zr1(1) = ABS( kk - km1 ) * umask(ji-1, jj)
+                  zr1(2) = ABS( kk - kp1 ) * umask(ji  , jj)
                END IF
-               ! i+1
-               k2 = mbkt(ji+1,jj)
-               IF ( ( (k1 > k2) .AND. (gdepw_0(ji,jj,jpk) < gdepw_0(ji+1,jj,jpk)) ) .OR. &
-                  & ( (k1 < k2) .AND. (gdepw_0(ji,jj,jpk) > gdepw_0(ji+1,jj,jpk)) ) ) THEN
-                  zr1(2) = ABS( mbkt(ji,jj) - mbkt(ji+1,jj) ) * umask(ji,jj)
-               END IF
-               ! j+1
-               k2 = mbkt(ji,jj+1)
-               IF ( ( (k1 > k2) .AND. (gdepw_0(ji,jj,jpk) < gdepw_0(ji,jj+1,jpk)) ) .OR. &
-                  & ( (k1 < k2) .AND. (gdepw_0(ji,jj,jpk) > gdepw_0(ji,jj+1,jpk)) ) ) THEN
-                  zr1(3) = ABS( mbkt(ji,jj) - mbkt(ji,jj+1) ) * vmask(ji,jj)
-               END IF
-               ! j-1
-               k2 = mbkt(ji,jj-1)
-               IF ( ( (k1 > k2) .AND. (gdepw_0(ji,jj,jpk) < gdepw_0(ji,jj-1,jpk)) ) .OR. &
-                  & ( (k1 < k2) .AND. (gdepw_0(ji,jj,jpk) > gdepw_0(ji,jj-1,jpk)) ) ) THEN
-                  zr1(4) = ABS( mbkt(ji,jj) - mbkt(ji,jj-1) ) * vmask(ji,jj-1)
+               ! j-direction
+               km1 = mbkt(ji,jj-1)
+               kp1 = mbkt(ji,jj+1)
+               dm1 = gdept_0(ji, jj-1, km1) - gdept_0(ji, jj, kk)
+               dp1 = gdept_0(ji, jj+1, kp1) - gdept_0(ji, jj, kk)
+               IF ( (dp1 * dm1) > 0. ) THEN
+                  zr1(3) = ABS( kk - km1 ) * vmask(ji, jj-1)
+                  zr1(4) = ABS( kk - kp1 ) * vmask(ji, jj  )
                END IF
                zx1(ji,jj) = REAL( MAXVAL(zr1(1:4)), wp )
@@ -599 +596 @@
          END DO
       END DO
+      IF( ln_loc_mes ) zx1 = zx1 * mes_msk 
       CALL lbc_lnk( zx1, 'T', 1. )
       !