Changeset 15271 for NEMO/branches/UKMO

Timestamp:

2021-09-20T11:12:08+02:00 (3 years ago)

Author:

dbruciaferri

Message:

rewriting saw tooth dignostic

Location:

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

Files:

• dom_oce.f90 (modified) (2 diffs)
• domwri.f90 (modified) (4 diffs)
• mes.F90 (modified) (1 diff)
• zgrmes.F90 (modified) (1 diff)

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

@@ -244 +244 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mes_msk      ! mask for local-ME coordinates (ln_loc_mes=TRUE)  
+                                                                       !    MEs-area (=1),
+                                                                       !    z-area (=0)
+
 
    !!----------------------------------------------------------------------
@@ -367 +372 @@
          &     tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                       & 
          &     ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , &
-         &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) )
+         &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , mes_msk(jpi,jpj) , STAT=ierr(9) )
 
 ! (ISF) Allocation of basic array   

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. )
       !

NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/mes.F90

@@ -1 +1 @@
 MODULE mes
    !!==============================================================================
-   !!                       ***  MODULE zgrmes   ***
+   !!                       ***  MODULE mes   ***
    !! Ocean initialization : Multiple Enveloped s coordinate (MES)
    !!==============================================================================

NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/zgrmes.F90

@@ -178 +178 @@
      CALL iom_get( inum, jpdom_data, 's2z_wgt', s2z_wgt)
 
+     mes_msk(:,:) = 1.
+     WHERE (s2z_msk(:,:).eq.0.0)  mes_msk(:,:) = 0.0
+
      DO jj = 1,jpj
         DO ji = 1,jpi