Changeset 3970 for branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

Timestamp:

2013-07-11T15:59:14+02:00 (11 years ago)

Author:

cbricaud

Message:

Time splitting update, see ticket #1079

File:

• branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90 (modified) (7 diffs)

branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

@@ -6 +6 @@
    !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite
    !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
+   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
    !!----------------------------------------------------------------------
 #if defined key_bdy 
@@ -27 +28 @@
 
    PUBLIC   bdy_dyn2d     ! routine called in dynspg_ts and bdy_dyn
+   PUBLIC   bdy_ssh       ! routine called in dynspg_ts or sshwzv
 
    !!----------------------------------------------------------------------
@@ -135 +137 @@
       REAL(wp) ::   zcorr                            ! Flather correction
       REAL(wp) ::   zforc                            ! temporary scalar
+      REAL(wp) ::   zflag, z1_2                      !    "        "
       !!----------------------------------------------------------------------
 
       IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_fla')
+
+      z1_2 = 0.5_wp
 
       ! ---------------------------------!
@@ -164 +169 @@
          !
          zcorr = - idx%flagu(jb) * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
-         zforc = dta%u2d(jb)
-         pu2d(ii,ij) = zforc + zcorr * umask(ii,ij,1) 
+         ! bg jchanut tschanges: Set zflag to 0 below to revert to Flather scheme
+!!         zforc = dta%u2d(jb)
+         zflag = ABS(idx%flagu(jb))
+         iim1 = ii + idx%flagu(jb)
+         zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pu2d(iim1,ij)
+         pu2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1) 
+         ! end jchanut tschanges
       END DO
       !
@@ -177 +187 @@
          !
          zcorr = - idx%flagv(jb) * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
-         zforc = dta%v2d(jb)
-         pv2d(ii,ij) = zforc + zcorr * vmask(ii,ij,1)
+         ! bg jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme
+!!         zforc = dta%v2d(jb)
+         zflag = ABS(idx%flagv(jb))
+         ijm1 = ij + idx%flagv(jb)
+         zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pv2d(ii,ijm1)
+         pv2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1)
+         ! end jchanut tschanges
       END DO
       CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )   ! Boundary points should be updated
@@ -186 +201 @@
       !
    END SUBROUTINE bdy_dyn2d_fla
+
+   SUBROUTINE bdy_ssh( zssh )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_ssh  ***
+      !!
+      !! ** Purpose : Duplicate sea level across open boundaries
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zssh ! Sea level
+      !!
+      INTEGER  ::   ib_bdy, ib, igrd                        ! local integers
+      INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   !   "       "
+
+      igrd = 1                       ! Everything is at T-points here
+
+      DO ib_bdy = 1, nb_bdy
+         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+            ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+            ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+            ! Set gradient direction:
+            zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
+            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
+            IF ( zcoef1+zcoef2 == 0 ) THEN
+               ! corner
+!               zcoef = tmask(ii-1,ij,1) + tmask(ii+1,ij,1) +  tmask(ii,ij-1,1) +  tmask(ii,ij+1,1)
+!               zssh(ii,ij) = zssh(ii-1,ij  ) * tmask(ii-1,ij  ,1) + &
+!                 &           zssh(ii+1,ij  ) * tmask(ii+1,ij  ,1) + &
+!                 &           zssh(ii  ,ij-1) * tmask(ii  ,ij-1,1) + &
+!                 &           zssh(ii  ,ij+1) * tmask(ii  ,ij+1,1)
+               zcoef = bdytmask(ii-1,ij) + bdytmask(ii+1,ij) +  bdytmask(ii,ij-1) +  bdytmask(ii,ij+1)
+               zssh(ii,ij) = zssh(ii-1,ij  ) * bdytmask(ii-1,ij  ) + &
+                 &           zssh(ii+1,ij  ) * bdytmask(ii+1,ij  ) + &
+                 &           zssh(ii  ,ij-1) * bdytmask(ii  ,ij-1) + &
+                 &           zssh(ii  ,ij+1) * bdytmask(ii  ,ij+1)
+               zssh(ii,ij) = ( zssh(ii,ij) / MAX( 1, zcoef) ) * tmask(ii,ij,1)
+            ELSE
+               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
+               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
+               zssh(ii,ij) = zssh(ii+ip,ij+jp) * tmask(ii+ip,ij+jp,1)
+            ENDIF
+         END DO
+
+         ! Boundary points should be updated
+         CALL lbc_bdy_lnk( zssh(:,:), 'T', 1., ib_bdy )
+      END DO
+
+   END SUBROUTINE bdy_ssh
 #else
    !!----------------------------------------------------------------------
@@ -192 +254 @@
 CONTAINS
    SUBROUTINE bdy_dyn2d( kt )      ! Empty routine
-      WRITE(*,*) 'bdy_dyn_frs: You should not have seen this print! error?', kt
+      INTEGER, intent(in) :: kt
+      WRITE(*,*) 'bdy_dyn2: You should not have seen this print! error?', kt
    END SUBROUTINE bdy_dyn2d
+
 #endif
 
    !!======================================================================
 END MODULE bdydyn2d
+