Changeset 3991 for branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

Timestamp:

2013-07-29T11:04:44+02:00 (11 years ago)

Author:

davestorkey

Message:

New branch from later branch point on trunk so you can do a clean
diff of all the changes. Copy in changes from dev_r3891_METO1_MERCATOR6_OBC_BDY_merge.

File:

• branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90 (modified) (8 diffs)

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

@@ -18 +18 @@
    USE dom_oce         ! ocean space and time domain
    USE bdy_oce         ! ocean open boundary conditions
+   USE bdylib          ! BDY library routines
    USE dynspg_oce      ! for barotropic variables
    USE phycst          ! physical constants
@@ -26 +27 @@
    PRIVATE
 
-   PUBLIC   bdy_dyn2d     ! routine called in dynspg_ts and bdy_dyn
+   PUBLIC   bdy_dyn2d   ! routine called in dynspg_ts and bdy_dyn
 
    !!----------------------------------------------------------------------
@@ -48 +49 @@
       DO ib_bdy=1, nb_bdy
 
-         SELECT CASE( nn_dyn2d(ib_bdy) )
-         CASE(jp_none)
+         SELECT CASE( cn_dyn2d(ib_bdy) )
+         CASE('none')
             CYCLE
-         CASE(jp_frs)
+         CASE('frs')
             CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy )
-         CASE(jp_flather)
+         CASE('flather')
             CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy )
+         CASE('orlanski')
+            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. )
+         CASE('orlanski_npo')
+            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. )
          CASE DEFAULT
             CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' )
@@ -89 +94 @@
          ij   = idx%nbj(jb,igrd)
          zwgt = idx%nbw(jb,igrd)
-         pu2d(ii,ij) = ( pu2d(ii,ij) + zwgt * ( dta%u2d(jb) - pu2d(ii,ij) ) ) * umask(ii,ij,1)
+         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1)
       END DO
       !
@@ -97 +102 @@
          ij   = idx%nbj(jb,igrd)
          zwgt = idx%nbw(jb,igrd)
-         pv2d(ii,ij) = ( pv2d(ii,ij) + zwgt * ( dta%v2d(jb) - pv2d(ii,ij) ) ) * vmask(ii,ij,1)
+         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1)
       END DO 
-      CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy ) 
-      CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy)   ! Boundary points should be updated
+      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy ) 
+      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy)   ! Boundary points should be updated
       !
       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_frs')
@@ -133 +138 @@
       INTEGER  ::   jb, igrd                         ! dummy loop indices
       INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses
+      REAL(wp), POINTER :: flagu, flagv              ! short cuts
       REAL(wp) ::   zcorr                            ! Flather correction
       REAL(wp) ::   zforc                            ! temporary scalar
@@ -160 +166 @@
          ii  = idx%nbi(jb,igrd)
          ij  = idx%nbj(jb,igrd) 
-         iim1 = ii + MAX( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice inside the boundary
-         iip1 = ii - MIN( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice outside the boundary 
+         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 
          !
-         zcorr = - idx%flagu(jb) * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
+         zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
          zforc = dta%u2d(jb)
-         pu2d(ii,ij) = zforc + zcorr * umask(ii,ij,1) 
+         pua2d(ii,ij) = zforc + zcorr * umask(ii,ij,1) 
       END DO
       !
@@ -173 +180 @@
          ii  = idx%nbi(jb,igrd)
          ij  = idx%nbj(jb,igrd) 
-         ijm1 = ij + MAX( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice inside the boundary
-         ijp1 = ij - MIN( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice outside the boundary 
+         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 
          !
-         zcorr = - idx%flagv(jb) * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
+         zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
          zforc = dta%v2d(jb)
-         pv2d(ii,ij) = zforc + zcorr * vmask(ii,ij,1)
-      END DO
-      CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )   ! Boundary points should be updated
-      CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy )   !
+         pva2d(ii,ij) = zforc + zcorr * vmask(ii,ij,1)
+      END DO
+      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated
+      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   !
       !
       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_fla')
       !
    END SUBROUTINE bdy_dyn2d_fla
+
+
+   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, ll_npo )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_dyn2d_orlanski  ***
+      !!             
+      !!              - Apply Orlanski radiation condition adaptively:
+      !!                  - radiation plus weak nudging at outflow points
+      !!                  - no radiation and strong nudging at inflow points
+      !! 
+      !!
+      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
+      INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set
+      LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version
+
+      INTEGER  ::   ib, igrd                               ! dummy loop indices
+      INTEGER  ::   ii, ij, iibm1, ijbm1                   ! indices
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_orlanski')
+      !
+      igrd = 2      ! Orlanski bc on u-velocity; 
+      !            
+      CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, ll_npo )
+
+      igrd = 3      ! Orlanski bc on v-velocity
+      !  
+      CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ll_npo )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski')
+      !
+      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated
+      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   !
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski')
+      !
+   END SUBROUTINE bdy_dyn2d_orlanski
+
 #else
    !!----------------------------------------------------------------------