Changeset 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DOM/domutl.F90

Timestamp:

2020-12-03T12:20:38+01:00 (3 years ago)

Author:

ayoung

Message:

Updated to trunk at 14020. Sette tests passed with change of results for configurations with non-linear ssh. Ticket #2506.

Location:

NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG

Files:

• . (modified) (1 prop)
• src/OCE/DOM/domutl.F90 (modified) (5 diffs)

NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG

@@ -8 +8 @@
 
 # SETTE
-^/utils/CI/sette@13292        sette
+^/utils/CI/sette_wave@13990         sette

@@ -8 +8 @@
 
 # SETTE
-^/utils/CI/sette@13292        sette
+^/utils/CI/sette_wave@13990         sette

NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DOM/domutl.F90

@@ -21 +21 @@
    PRIVATE
 
+   INTERFACE is_tile
+      MODULE PROCEDURE is_tile_2d, is_tile_3d, is_tile_4d
+   END INTERFACE is_tile
+
    PUBLIC dom_ngb    ! routine called in iom.F90 module
    PUBLIC dom_uniq   ! Called by dommsk and domwri
+   PUBLIC is_tile
 
    !!----------------------------------------------------------------------
@@ -48 +53 @@
       INTEGER , DIMENSION(2) ::   iloc
       REAL(wp)               ::   zlon, zmini
-      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist
+      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zdist
+      LOGICAL , DIMENSION(jpi,jpj) ::   llmsk
       !!--------------------------------------------------------------------
       !
@@ -54 +60 @@
       IF ( PRESENT(kkk) ) ik=kkk
       !
-      CALL dom_uniq(zmask,cdgrid)
-      !
       SELECT CASE( cdgrid )
-      CASE( 'U' )    ;   zglam(:,:) = glamu(:,:)   ;   zgphi(:,:) = gphiu(:,:)   ;   zmask(:,:) = zmask(:,:) * umask(:,:,ik)
-      CASE( 'V' )    ;   zglam(:,:) = glamv(:,:)   ;   zgphi(:,:) = gphiv(:,:)   ;   zmask(:,:) = zmask(:,:) * vmask(:,:,ik)
-      CASE( 'F' )    ;   zglam(:,:) = glamf(:,:)   ;   zgphi(:,:) = gphif(:,:)   ;   zmask(:,:) = zmask(:,:) * fmask(:,:,ik)
-      CASE DEFAULT   ;   zglam(:,:) = glamt(:,:)   ;   zgphi(:,:) = gphit(:,:)   ;   zmask(:,:) = zmask(:,:) * tmask(:,:,ik)
+      CASE( 'U' ) ;   zglam(:,:) = glamu(:,:)   ;   zgphi(:,:) = gphiu(:,:)   ;   llmsk(:,:) = tmask_h(:,:) * umask(:,:,ik) == 1._wp
+      CASE( 'V' ) ;   zglam(:,:) = glamv(:,:)   ;   zgphi(:,:) = gphiv(:,:)   ;   llmsk(:,:) = tmask_h(:,:) * vmask(:,:,ik) == 1._wp
+      CASE( 'F' ) ;   zglam(:,:) = glamf(:,:)   ;   zgphi(:,:) = gphif(:,:)   ;   llmsk(:,:) = tmask_h(:,:) * fmask(:,:,ik) == 1._wp
+      CASE DEFAULT;   zglam(:,:) = glamt(:,:)   ;   zgphi(:,:) = gphit(:,:)   ;   llmsk(:,:) = tmask_h(:,:) * tmask(:,:,ik) == 1._wp
       END SELECT
       !
@@ -68 +72 @@
       IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
       zglam(:,:) = zglam(:,:) - zlon
-
+      !
       zgphi(:,:) = zgphi(:,:) - plat
       zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
-      
-      IF( lk_mpp ) THEN  
-         CALL mpp_minloc( 'domngb', zdist(:,:), zmask, zmini, iloc)
-         kii = iloc(1) ; kjj = iloc(2)
-      ELSE
-         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
-         kii = iloc(1) + nimpp - 1
-         kjj = iloc(2) + njmpp - 1
-      ENDIF
+      !
+      CALL mpp_minloc( 'domngb', zdist(:,:), llmsk, zmini, iloc, ldhalo = .TRUE. )
+      kii = iloc(1)
+      kjj = iloc(2)
       !
    END SUBROUTINE dom_ngb
@@ -115 +114 @@
       !
    END SUBROUTINE dom_uniq
-   
+
+
+   FUNCTION is_tile_2d( pt )
+      !!
+      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pt
+      INTEGER :: is_tile_2d
+      !!
+      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_2d = 1
+      ELSE
+         is_tile_2d = 0
+      ENDIF
+   END FUNCTION is_tile_2d
+
+
+   FUNCTION is_tile_3d( pt )
+      !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pt
+      INTEGER :: is_tile_3d
+      !!
+      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_3d = 1
+      ELSE
+         is_tile_3d = 0
+      ENDIF
+   END FUNCTION is_tile_3d
+
+
+   FUNCTION is_tile_4d( pt )
+      !!
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(in) ::   pt
+      INTEGER :: is_tile_4d
+      !!
+      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_4d = 1
+      ELSE
+         is_tile_4d = 0
+      ENDIF
+   END FUNCTION is_tile_4d
+
    !!======================================================================
 END MODULE domutl

@@ -8 +8 @@
 
 # SETTE
-^/utils/CI/sette@13292        sette
+^/utils/CI/sette_wave@13990         sette