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

Timestamp:

2018-05-31T11:48:34+02:00 (6 years ago)

Author:

frrh

Message:

Work out N-fold mask points for U and V grids based on
value flipping during N-fold lbc_lnk operations.
It's much easier this way.
Tidy up remaining code.

File:

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

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

@@ +1 @@
+
 MODULE dommsk
    !!======================================================================
@@ -138 +139 @@
       REAL(wp) ::  zphi_drake_passage, zshlat_antarc
       REAL(wp), POINTER, DIMENSION(:,:) ::  zwf
+      REAL(wp) :: uv(jpi,jpj)
       !!
       NAMELIST/namlbc/ rn_shlat, ln_vorlat
@@ -223 +225 @@
       ! --------------------
       tmask_i(:,:) = ssmask(:,:)            ! (ISH) tmask_i = 1 even on the ice shelf
+
       iif = jpreci                         ! ???
       iil = nlci - jpreci + 1
@@ -232 +235 @@
       tmask_i(   :   , 1 :ijf) = 0._wp      ! first rows
       tmask_i(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
-
-      tmask_i_3d(:,:,:) = tmask(:,:,:)      ! Initialise 3D interior tmask with standard t mask
-      ! Now mask out any wrap columns
-      tmask_i_3d( 1 :iif,:,:) = 0._wp       ! first columns
-      tmask_i_3d(iil:jpi,:,:) = 0._wp       ! last  columns (including mpp extra columns)
-      ! Now mask out any extra rows
-      tmask_i_3d(:,1:ijf,:) = 0._wp         ! first rows
-      tmask_i_3d(:,ijl:jpj,:) = 0._wp       ! last  rows (including mpp extra rows)
-
 
       ! north fold mask
@@ -252 +246 @@
             DO ji = iif+1, iil-1
                tmask_i(ji,nlej-1) = tmask_i(ji,nlej-1) * tpol(mig(ji))
-               ! It would seem logical that the following SHOULD be applied, 
-               ! but the existing code in iom.F90 which we are trying to 
-               ! replicate, and where we aim to use this array simply uses 
-               ! tmask which does NOT account for masking in the N-fold.  
-               ! tmask_i_3d(ji,nlej-1,:) = tmask_i_3d(ji,nlej-1,:) * tpol(mig(ji))
             END DO
          ENDIF
@@ -299 +288 @@
       CALL lbc_lnk( fmask_i, 'F', 1._wp )
 
-      ! Set up interior 3d U mask
-      umask_i_3d(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)
-      CALL lbc_lnk( umask_i_3d, 'U', 1. )
+
+      ! 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(:,:)
+      END DO
+
+      ! Set up mask for diagnostics on U points, to exclude duplicate
+      ! data points in wrap and N-fold regions. 
+      umask_i_diag(:,:,:) = 1.0
+      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_3d( 1 :iif,:,:) = 0._wp       ! first columns
-      umask_i_3d(iil:jpi,:,:) = 0._wp       ! last  columns (including mpp extra 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
+
+      ! Set up mask for diagnostics on V points, to exclude duplicate
+      ! data points in wrap and N-fold regions. 
+      vmask_i_diag(:,:,:) = 1.0
+      vmask_i_diag(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)
+      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
-      umask_i_3d(:,1:ijf,:) = 0._wp         ! first rows
-      umask_i_3d(:,ijl:jpj,:) = 0._wp       ! last  rows (including mpp extra rows)
-
-      ! Set up interior 3d V mask
-      vmask_i_3d(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)
-      CALL lbc_lnk( vmask_i_3d, 'V', 1. )
-      ! Now mask out any wrap columns
-      vmask_i_3d( 1 :iif,:,:) = 0._wp       ! first columns
-      vmask_i_3d(iil:jpi,:,:) = 0._wp       ! last  columns (including mpp extra columns)
-      ! Now mask out any extra rows
-      vmask_i_3d(:,1:ijf,:) = 0._wp         ! first rows
-      vmask_i_3d(:,ijl:jpj,:) = 0._wp       ! last  rows (including mpp 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