Changeset 11074 for NEMO/branches/2019

Timestamp:

2019-06-04T17:46:46+02:00 (5 years ago)

Author:

girrmann

Message:

dev_r10984_HPC-13 : bug fix and cleaning of flather, see #2287 and #2285

File:

• NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn2d.F90 (modified) (5 diffs)

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn2d.F90

@@ -14 +14 @@
    !!   bdy_ssh            : Duplicate sea level across open boundaries
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers 
+   USE oce, only : sshdta => spgu             ! ocean dynamics and tracers 
    USE dom_oce         ! ocean space and time domain
    USE bdy_oce         ! ocean open boundary conditions
@@ -169 +169 @@
 
       INTEGER  ::   jb, igrd                         ! dummy loop indices
-      INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses
+      INTEGER  ::   ii, ij                           ! 2D addresses
+      INTEGER  ::   iiTrim, ijTrim                   ! T pts i/j-indice on the rim
+      INTEGER  ::   iiToce, ijToce, iiUoce, ijVoce   ! T, U and V pts i/j-indice of the ocean next to the rim
       REAL(wp), POINTER :: flagu, flagv              ! short cuts
-      REAL(wp) ::   zcorr                            ! Flather correction
-      REAL(wp) ::   zforc                            ! temporary scalar
-      REAL(wp) ::   zflag, z1_2                      !    "        "
+      REAL(wp) ::   zfla                             ! Flather correction
+      REAL(wp) ::   z1_2                             ! 
       !!----------------------------------------------------------------------
 
@@ -180 +181 @@
       ! ---------------------------------!
       ! Flather boundary conditions     :!
-      ! ---------------------------------! 
-     
-!!! REPLACE spgu with nemo_wrk work space
-
-      ! Fill temporary array with ssh data (here spgu):
+      ! ---------------------------------!
+
+      ! Fill temporary array with ssh data (here we use spgu with the alias sshdta):
       igrd = 1
-      spgu(:,:) = 0.0
+      sshdta(:,:) = 0.0
       DO jb = 1, idx%nblenrim(igrd)
          ii = idx%nbi(jb,igrd)
          ij = idx%nbj(jb,igrd)
          IF( ll_wd ) THEN
-            spgu(ii, ij) = dta%ssh(jb)  - ssh_ref 
+            sshdta(ii, ij) = dta%ssh(jb)  - ssh_ref 
          ELSE
-            spgu(ii, ij) = dta%ssh(jb)
+            sshdta(ii, ij) = dta%ssh(jb)
          ENDIF
       END DO
@@ -201 +200 @@
       !             ! I think we should rather use after ssh ?
       DO jb = 1, idx%nblenrim(igrd)
-         ii  = idx%nbi(jb,igrd)
-         ij  = idx%nbj(jb,igrd)
+         ii = idx%nbi(jb,igrd)
+         ij = idx%nbj(jb,igrd)
          flagu => idx%flagu(jb,igrd)
-         iim1 = ii + MAX( 0, INT( flagu ) )   ! T pts i-indice inside the boundary
-         iip1 = ii - MIN( 0, INT( flagu ) )   ! T pts i-indice outside the boundary 
-         IF( iim1 > jpi .OR. iip1 > jpi )   CYCLE
-         !
-         zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
-
-         ! jchanut tschanges: Set zflag to 0 below to revert to Flather scheme
-         ! Use characteristics method instead
-         zflag = ABS(flagu)
-         zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(iim1,ij)
-         pua2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1) 
+         IF( flagu == 0. ) THEN
+            pua2d(ii,ij) = dta%u2d(jb)
+         ELSE      ! T pts j-indice       on the rim          on the ocean next to the rim on T and U points
+            IF( flagu ==  1. ) THEN   ;   iiTrim = ii     ;   iiToce = ii+1   ;   iiUoce = ii+1   ;   ENDIF
+            IF( flagu == -1. ) THEN   ;   iiTrim = ii+1   ;   iiToce = ii     ;   iiUoce = ii-1   ;   ENDIF
+            !
+            ! Rare case : rim is parallel to the mpi subdomain border and on the halo : point will be received
+            IF( iiTrim > jpi .OR. iiToce > jpi .OR. iiUoce > jpi .OR. iiUoce < 1 )   CYCLE   
+            !
+            zfla = pua2d(iiUoce,ij) - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iiToce,ij) - sshdta(iiTrim,ij) )
+            !
+            ! jchanut tschanges, use characteristics method (Blayo et Debreu, 2005) :
+            ! mix Flather scheme with velocity of the ocean next to the rim
+            pua2d(ii,ij) =  z1_2 * ( dta%u2d(jb) + zfla )
+         END IF
       END DO
       !
@@ -220 +223 @@
       !             ! remember that flagv=-1 if normal velocity direction is outward
       DO jb = 1, idx%nblenrim(igrd)
-         ii  = idx%nbi(jb,igrd)
-         ij  = idx%nbj(jb,igrd)
+         ii = idx%nbi(jb,igrd)
+         ij = idx%nbj(jb,igrd)
          flagv => idx%flagv(jb,igrd)
-         ijm1 = ij + MAX( 0, INT( flagv ) )   ! T pts j-indice inside the boundary
-         ijp1 = ij - MIN( 0, INT( flagv ) )   ! T pts j-indice outside the boundary 
-         IF( ijm1 > jpj .OR. ijp1 > jpj )   CYCLE
-         !
-         zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
-
-         ! jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme
-         ! Use characteristics method instead
-         zflag = ABS(flagv)
-         zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1)
-         pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1)
+         IF( flagv == 0. ) THEN
+            pva2d(ii,ij) = dta%v2d(jb)
+         ELSE      ! T pts j-indice       on the rim          on the ocean next to the rim on T and V points
+            IF( flagv ==  1. ) THEN   ;   ijTrim = ij     ;   ijToce = ij+1   ;   ijVoce = ij+1   ;   ENDIF
+            IF( flagv == -1. ) THEN   ;   ijTrim = ij+1   ;   ijToce = ij     ;   ijVoce = ij-1   ;   ENDIF
+            !
+            ! Rare case : rim is parallel to the mpi subdomain border and on the halo : point will be received
+            IF( ijTrim > jpj .OR. ijToce > jpj .OR. ijVoce > jpj .OR. ijVoce < 1 )   CYCLE
+            !
+            zfla = pva2d(ii,ijVoce) - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii,ijToce) - sshdta(ii,ijTrim) )
+            !
+            ! jchanut tschanges, use characteristics method (Blayo et Debreu, 2005) :
+            ! mix Flather scheme with velocity of the ocean next to the rim
+            pva2d(ii,ij) =  z1_2 * ( dta%v2d(jb) + zfla )
+         END IF
       END DO
       !