Changeset 9710 for branches/UKMO/dev_r5518_GO6_diag_bitcomp/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

Timestamp:

2018-05-31T13:46:36+02:00 (6 years ago)

Author:

frrh

Message:

Use existing dom_uniq routine to mask duplicate points.
This routine does essentailly what I already do and
although it's slightly excessive for what we need,
it allows us to reduce the number of lines
of code we need by calling an existing routine
(which is tried and tested!).

File:

• branches/UKMO/dev_r5518_GO6_diag_bitcomp/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90 (modified) (5 diffs)

branches/UKMO/dev_r5518_GO6_diag_bitcomp/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

@@ -31 +31 @@
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
    USE wrk_nemo        ! Memory allocation
+   USE domwri
    USE timing          ! Timing
 
@@ -139 +140 @@
       REAL(wp) ::  zphi_drake_passage, zshlat_antarc
       REAL(wp), POINTER, DIMENSION(:,:) ::  zwf
-      REAL(wp) :: uv(jpi,jpj)
+      REAL(wp) :: uvt(jpi,jpj)   ! dummy array for masking purposes.
       !!
       NAMELIST/namlbc/ rn_shlat, ln_vorlat
@@ -291 +292 @@
       ! Set up mask for diagnostics on T points, to exclude duplicate
       ! data points in wrap and N-fold regions. 
-      DO jk = 1, jpk
-         tmask_i_diag(:,:,jk) = tmask(:,:,jk) * tmask_i(:,:)
+      CALL dom_uniq( uvt, 'T' )
+      DO jk = 1, jpk
+         tmask_i_diag(:,:,jk) = tmask(:,:,jk) * uvt(:,:)
       END DO
 
@@ -300 +302 @@
       umask_i_diag(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)
       CALL lbc_lnk( umask_i_diag, 'U', 1. )
-      ! Now mask out any wrap columns
-      umask_i_diag( 1 :iif,:,:) = 0._wp       ! first columns
-      umask_i_diag(iil:jpi,:,:) = 0._wp       ! last  columns (including mpp extra columns)
-      ! Now mask out any extra bottom rows
-      umask_i_diag(:,1:ijf,:) = 0._wp         ! first rows
-
-      ! Now find which points change sign during a U lbc_lnk to find
-      ! out which points to mask in the N fold.   
-      uv(:,:) = 1.0
-      CALL lbc_lnk( uv, 'U', -1. )
-
-      ! Now find out which points have changed sign and mask them 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF (uv(ji,jj) < 0.0) THEN
-               umask_i_diag(ji,jj,:) = 0.0
-            END IF
-         END DO
-      END DO
+
+      ! Now mask out any duplicate points
+      CALL dom_uniq( uvt, 'U' )
+      DO jk = 1, jpk
+         umask_i_diag(:,:,jk) = umask_i_diag(:,:,jk) * uvt(:,:)
+      END DO
+
 
       ! Set up mask for diagnostics on V points, to exclude duplicate
@@ -326 +316 @@
       CALL lbc_lnk( vmask_i_diag, 'V', 1. )
 
-      ! Now mask out any wrap columns
-      vmask_i_diag( 1 :iif,:,:) = 0._wp       ! first columns
-      vmask_i_diag(iil:jpi,:,:) = 0._wp       ! last  columns (including mpp extra columns)
-      ! Now mask out any extra rows
-      vmask_i_diag(:,1:ijf,:) = 0._wp         ! first rows
-
-      ! Now find which points change sign during a V lbc_lnk to find
-      ! out which points to mask in the N fold.   
-      uv(:,:) = 1.0
-      CALL lbc_lnk( uv, 'V', -1. )
-
-      ! Now find out which points have changed sign and mask them 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF (uv(ji,jj) < 0.0) THEN
-               vmask_i_diag(ji,jj,:) = 0.0
-            END IF
-         END DO
-      END DO
+      CALL lbc_lnk( vmask_i_diag, 'V', 1. )
+
+      ! Now mask out any duplicate points
+      CALL dom_uniq( uvt, 'V' )
+      DO jk = 1, jpk
+         vmask_i_diag(:,:,jk) = vmask_i_diag(:,:,jk) * uvt(:,:)
+      END DO
+