Changeset 7087 for branches/UKMO/AMM15_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

Timestamp:

2016-10-25T15:46:01+02:00 (7 years ago)

Author:

jgraham

Message:

Bring in options for 3D U/V boundaries, following changes made for CO6.
Options added are 'zerograd' or 'neumann' boundary conditions.

File:

• branches/UKMO/AMM15_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90 (modified) (3 diffs)

branches/UKMO/AMM15_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

@@ -61 +61 @@
          CASE('zero')
             CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE('zerograd') 
+            CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )       
+         CASE('neumann') 
+            CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy )
          CASE('orlanski')
             CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. )
@@ -117 +121 @@
 
    END SUBROUTINE bdy_dyn3d_spe
+
+   SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy ) 
+      !!---------------------------------------------------------------------- 
+      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  *** 
+      !! 
+      !! ** Purpose : - Enforce a zero gradient of normal velocity 
+      !! 
+      !!---------------------------------------------------------------------- 
+      INTEGER                     ::   kt 
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
+      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
+      !! 
+      INTEGER  ::   jb, jk         ! dummy loop indices 
+      INTEGER  ::   ii, ij, igrd   ! local integers 
+      REAL(wp) ::   zwgt           ! boundary weight 
+      INTEGER  ::   fu, fv 
+      !!---------------------------------------------------------------------- 
+      ! 
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zgrad') 
+      ! 
+      igrd = 2                      ! Copying tangential velocity into bdy points 
+      DO jb = 1, idx%nblenrim(igrd) 
+         DO jk = 1, jpkm1 
+            ii   = idx%nbi(jb,igrd) 
+            ij   = idx%nbj(jb,igrd) 
+            fu   = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 
+            ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) & 
+                        &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 
+         END DO 
+      END DO 
+      ! 
+      igrd = 3                      ! Copying tangential velocity into bdy points 
+      DO jb = 1, idx%nblenrim(igrd) 
+         DO jk = 1, jpkm1 
+            ii   = idx%nbi(jb,igrd) 
+            ij   = idx%nbj(jb,igrd) 
+            fv   = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 
+            va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 
+                        &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 
+         END DO 
+      END DO 
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
+      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
+      ! 
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
+ 
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zgrad') 
+ 
+   END SUBROUTINE bdy_dyn3d_zgrad 
 
    SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy )
@@ -303 +357 @@
    END SUBROUTINE bdy_dyn3d_dmp
 
+   SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy ) 
+      !!---------------------------------------------------------------------- 
+      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  *** 
+      !!              
+      !!              - Apply Neumann condition to baroclinic velocities.  
+      !!              - Wrapper routine for bdy_nmn 
+      !!  
+      !! 
+      !!---------------------------------------------------------------------- 
+      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
+      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
+ 
+      INTEGER  ::   jb, igrd                               ! dummy loop indices 
+      !!---------------------------------------------------------------------- 
+ 
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_nmn') 
+      ! 
+      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.  
+      ! 
+      igrd = 2      ! Neumann bc on u-velocity;  
+      !             
+      CALL bdy_nmn( idx, igrd, ua ) 
+ 
+      igrd = 3      ! Neumann bc on v-velocity 
+      !   
+      CALL bdy_nmn( idx, igrd, va ) 
+      ! 
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
+      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 
+      ! 
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_nmn') 
+      ! 
+   END SUBROUTINE bdy_dyn3d_nmn 
+ 
+
 #else
    !!----------------------------------------------------------------------