Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

Timestamp:

2010-12-27T18:33:53+01:00 (13 years ago)

Author:

rblod

Message:

Update NEMOGCM from branch nemo_v3_3_beta

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90 (modified) (6 diffs, 1 prop)

trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

@@ -8 +8 @@
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
    !!            3.2  !  2008-04  (R. Benshila) consider velocity instead of transport 
+   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations 
+   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
    !!----------------------------------------------------------------------
 #if defined key_bdy 
@@ -34 +36 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -54 +55 @@
       INTEGER, INTENT( in ) ::   kt   ! Main time step counter
       !!
-      INTEGER  ::   ib, ik, igrd      ! dummy loop indices
-      INTEGER  ::   ii, ij            ! 2D addresses
-      REAL(wp) ::   zwgt              ! boundary weight
+      INTEGER  ::   jb, jk         ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
       !!----------------------------------------------------------------------
       !
-      IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing. 
-
+      IF(ln_dyn_frs) THEN       ! If this is false, then this routine does nothing. 
+         !
          IF( kt == nit000 ) THEN
             IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'bdy_dyn : Flow Relaxation Scheme on momentum'
+            IF(lwp) WRITE(numout,*) 'bdy_dyn_frs : Flow Relaxation Scheme on momentum'
             IF(lwp) WRITE(numout,*) '~~~~~~~'
          ENDIF
          !
          igrd = 2                      ! Relaxation of zonal velocity
-         DO ib = 1, nblen(igrd)
-            DO ik = 1, jpkm1
-               ii = nbi(ib,igrd)
-               ij = nbj(ib,igrd)
-               zwgt = nbw(ib,igrd)
-               ua(ii,ij,ik) = ( ua(ii,ij,ik) * ( 1.- zwgt ) + ubdy(ib,ik) * zwgt ) * umask(ii,ij,ik)
+         DO jb = 1, nblen(igrd)
+            DO jk = 1, jpkm1
+               ii   = nbi(jb,igrd)
+               ij   = nbj(jb,igrd)
+               zwgt = nbw(jb,igrd)
+               ua(ii,ij,jk) = ( ua(ii,ij,jk) * ( 1.- zwgt ) + ubdy(jb,jk) * zwgt ) * umask(ii,ij,jk)
             END DO
          END DO
          !
          igrd = 3                      ! Relaxation of meridional velocity
-         DO ib = 1, nblen(igrd)
-            DO ik = 1, jpkm1
-               ii = nbi(ib,igrd)
-               ij = nbj(ib,igrd)
-               zwgt = nbw(ib,igrd)
-               va(ii,ij,ik) = ( va(ii,ij,ik) * ( 1.- zwgt ) + vbdy(ib,ik) * zwgt ) * vmask(ii,ij,ik)
+         DO jb = 1, nblen(igrd)
+            DO jk = 1, jpkm1
+               ii   = nbi(jb,igrd)
+               ij   = nbj(jb,igrd)
+               zwgt = nbw(jb,igrd)
+               va(ii,ij,jk) = ( va(ii,ij,jk) * ( 1.- zwgt ) + vbdy(jb,jk) * zwgt ) * vmask(ii,ij,jk)
             END DO
          END DO 
+         CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated
          !
-         CALL lbc_lnk( ua, 'U', -1. )   ! Boundary points should be updated
-         CALL lbc_lnk( va, 'V', -1. )   !
-         !
-      ENDIF ! ln_bdy_dyn_frs
-
+      ENDIF ! ln_dyn_frs
+      !
    END SUBROUTINE bdy_dyn_frs
 
 
-#if defined key_dynspg_exp || defined key_dynspg_ts
+# if defined   key_dynspg_exp   ||   defined key_dynspg_ts
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_exp'        OR              explicit sea surface height
+   !!   'key_dynspg_ts '                  split-explicit sea surface height
+   !!----------------------------------------------------------------------
+   
 !! Option to use Flather with dynspg_flt not coded yet...
+
    SUBROUTINE bdy_dyn_fla( pssh )
       !!----------------------------------------------------------------------
@@ -102 +107 @@
       !!             
       !!              - Apply Flather boundary conditions on normal barotropic velocities 
-      !!                (ln_bdy_dyn_fla=.true. or ln_bdy_tides=.true.)
+      !!                (ln_dyn_fla=.true. or ln_tides=.true.)
       !!
       !! ** WARNINGS about FLATHER implementation:
@@ -119 +124 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh
 
-      INTEGER  ::   ib, igrd                         ! dummy loop indices
+      INTEGER  ::   jb, igrd                         ! dummy loop indices
       INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses
       REAL(wp) ::   zcorr                            ! Flather correction
@@ -129 +134 @@
       ! ---------------------------------! 
      
-      IF(ln_bdy_dyn_fla .OR. ln_bdy_tides) THEN ! If these are both false, then this routine does nothing. 
+      IF(ln_dyn_fla .OR. ln_tides) THEN ! If these are both false, then this routine does nothing. 
 
          ! Fill temporary array with ssh data (here spgu):
-         igrd = 1
+         igrd = 4
          spgu(:,:) = 0.0
-         DO ib = 1, nblenrim(igrd)
-            ii = nbi(ib,igrd)
-            ij = nbj(ib,igrd)
-            IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy(ib)
-            IF( ln_bdy_tides )   spgu(ii, ij) = spgu(ii, ij) + sshtide(ib)
+         DO jb = 1, nblenrim(igrd)
+            ii = nbi(jb,igrd)
+            ij = nbj(jb,igrd)
+            IF( ln_dyn_fla ) spgu(ii, ij) = sshbdy(jb)
+            IF( ln_tides )   spgu(ii, ij) = spgu(ii, ij) + sshtide(jb)
          END DO
          !
-         igrd = 2      ! Flather bc on u-velocity; 
+         igrd = 5      ! Flather bc on u-velocity; 
          !             ! remember that flagu=-1 if normal velocity direction is outward
          !             ! I think we should rather use after ssh ?
-         DO ib = 1, nblenrim(igrd)
-            ii  = nbi(ib,igrd)
-            ij  = nbj(ib,igrd) 
-            iim1 = ii + MAX( 0, INT( flagu(ib) ) )   ! T pts i-indice inside the boundary
-            iip1 = ii - MIN( 0, INT( flagu(ib) ) )   ! T pts i-indice outside the boundary 
+         DO jb = 1, nblenrim(igrd)
+            ii  = nbi(jb,igrd)
+            ij  = nbj(jb,igrd) 
+            iim1 = ii + MAX( 0, INT( flagu(jb) ) )   ! T pts i-indice inside the boundary
+            iip1 = ii - MIN( 0, INT( flagu(jb) ) )   ! T pts i-indice outside the boundary 
             !
-            zcorr = - flagu(ib) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
-            zforc = ubtbdy(ib) + utide(ib)
+            zcorr = - flagu(jb) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
+            zforc = ubtbdy(jb) + utide(jb)
             ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1) 
          END DO
          !
-         igrd = 3      ! Flather bc on v-velocity
+         igrd = 6      ! Flather bc on v-velocity
          !             ! remember that flagv=-1 if normal velocity direction is outward
-         DO ib = 1, nblenrim(igrd)
-            ii  = nbi(ib,igrd)
-            ij  = nbj(ib,igrd) 
-            ijm1 = ij + MAX( 0, INT( flagv(ib) ) )   ! T pts j-indice inside the boundary
-            ijp1 = ij - MIN( 0, INT( flagv(ib) ) )   ! T pts j-indice outside the boundary 
+         DO jb = 1, nblenrim(igrd)
+            ii  = nbi(jb,igrd)
+            ij  = nbj(jb,igrd) 
+            ijm1 = ij + MAX( 0, INT( flagv(jb) ) )   ! T pts j-indice inside the boundary
+            ijp1 = ij - MIN( 0, INT( flagv(jb) ) )   ! T pts j-indice outside the boundary 
             !
-            zcorr = - flagv(ib) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
-            zforc = vbtbdy(ib) + vtide(ib)
+            zcorr = - flagv(jb) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
+            zforc = vbtbdy(jb) + vtide(jb)
             va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1)
          END DO
+         CALL lbc_lnk( ua_e, 'U', -1. )   ! Boundary points should be updated
+         CALL lbc_lnk( va_e, 'V', -1. )   !
          !
-      ENDIF ! ln_bdy_dyn_fla .or. ln_bdy_tides
+      ENDIF ! ln_dyn_fla .or. ln_tides
       !
    END SUBROUTINE bdy_dyn_fla