Changeset 12807 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domutl.F90

Timestamp:

2020-04-23T15:14:45+02:00 (4 years ago)

Author:

smasson

Message:

Extra_Halo: input file only over inner domain + new variables names, see #2366

File:

• NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domutl.F90 (moved) (moved from NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domngb.F90) (4 diffs)

NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domutl.F90

@@ -1 @@
-MODULE domngb
+MODULE domutl
    !!======================================================================
-   !!                       ***  MODULE  domngb  ***
-   !! Grid search:  find the closest grid point from a given on/lat position
+   !!                       ***  MODULE  domutl  ***
+   !! Grid utilities:
    !!======================================================================
-   !! History : 3.2  !  2009-11  (S. Masson)  Original code
+   !! History : 4.2  !  2020-04  (S. Masson)  Original code
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   dom_ngb       : find the closest grid point from a given lon/lat position
+   !!   dom_uniq      : identify unique point of a grid (TUVF)
    !!----------------------------------------------------------------------
+   !
    USE dom_oce        ! ocean space and time domain
    !
    USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp        ! for mppsum
 
@@ -18 +21 @@
    PRIVATE
 
-   PUBLIC   dom_ngb   ! routine called in iom.F90 module
+   PUBLIC dom_ngb    ! routine called in iom.F90 module
+   PUBLIC dom_uniq   ! Called by dommsk and domwri
 
    !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! NEMO/OCE 4.2 , NEMO Consortium (2020)
    !! $Id$ 
    !! Software governed by the CeCILL license (see ./LICENSE)
@@ -47 +51 @@
       !!--------------------------------------------------------------------
       !
-      zmask(:,:) = 0._wp
       ik = 1
       IF ( PRESENT(kkk) ) ik=kkk
+      !
+      CALL dom_uniq(zmask,cdgrid)
+      !
       SELECT CASE( cdgrid )
-      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
-      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
-      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
-      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
+      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)
       END SELECT
-
+      !
       zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
       zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
@@ -77 +83 @@
    END SUBROUTINE dom_ngb
 
+
+   SUBROUTINE dom_uniq( puniq, cdgrd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_uniq  ***
+      !!                   
+      !! ** Purpose :   identify unique point of a grid (TUVF)
+      !!
+      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element
+      !!                2) check which elements have been changed
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   ! 
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   ! 
+      !
+      REAL(wp)                       ::  zshift   ! shift value link to the process number
+      INTEGER                        ::  ji       ! dummy loop indices
+      LOGICAL , DIMENSION(jpi,jpj,1) ::   lluniq  ! store whether each point is unique or not
+      REAL(wp), DIMENSION(jpi,jpj  ) ::   ztstref
+      !!----------------------------------------------------------------------
+      !
+      ! build an array with different values for each element 
+      ! in mpp: make sure that these values are different even between process
+      ! -> apply a shift value according to the process number
+      zshift = jpimax * jpjmax * ( narea - 1 )
+      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
+      !
+      puniq(:,:) = ztstref(:,:)                    ! default definition
+      CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )   ! apply boundary conditions
+      lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have not been changed 
+      !
+      puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp )
+      !
+   END SUBROUTINE dom_uniq
+   
    !!======================================================================
-END MODULE domngb
+END MODULE domutl