New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
bdydyn3d.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90 @ 3294

Last change on this file since 3294 was 3294, checked in by rblod, 12 years ago

Merge of 3.4beta into the trunk

File size: 5.2 KB
Line 
1MODULE bdydyn3d
2   !!======================================================================
3   !!                       ***  MODULE  bdydyn3d  ***
4   !! Unstructured Open Boundary Cond. :   Flow relaxation scheme on baroclinic velocities
5   !!======================================================================
6   !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite
7   !!----------------------------------------------------------------------
8#if defined key_bdy 
9   !!----------------------------------------------------------------------
10   !!   'key_bdy' :                    Unstructured Open Boundary Condition
11   !!----------------------------------------------------------------------
12   !!   bdy_dyn3d        : apply open boundary conditions to baroclinic velocities
13   !!   bdy_dyn3d_frs    : apply Flow Relaxation Scheme
14   !!----------------------------------------------------------------------
15   USE timing          ! Timing
16   USE oce             ! ocean dynamics and tracers
17   USE dom_oce         ! ocean space and time domain
18   USE bdy_oce         ! ocean open boundary conditions
19   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
20   USE in_out_manager  !
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   bdy_dyn3d     ! routine called by bdy_dyn
26
27   !!----------------------------------------------------------------------
28   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
29   !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $
30   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
31   !!----------------------------------------------------------------------
32CONTAINS
33
34   SUBROUTINE bdy_dyn3d( kt )
35      !!----------------------------------------------------------------------
36      !!                  ***  SUBROUTINE bdy_dyn3d  ***
37      !!
38      !! ** Purpose : - Apply open boundary conditions for baroclinic velocities
39      !!
40      !!----------------------------------------------------------------------
41      INTEGER, INTENT( in ) :: kt     ! Main time step counter
42      !!
43      INTEGER               :: ib_bdy ! loop index
44      !!
45
46      DO ib_bdy=1, nb_bdy
47
48!!$         IF ( using Orlanski radiation conditions ) THEN
49!!$            CALL bdy_rad( kt,  bdyidx(ib_bdy) )
50!!$         ENDIF
51
52         SELECT CASE( nn_dyn3d(ib_bdy) )
53         CASE(jp_none)
54            CYCLE
55         CASE(jp_frs)
56            CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
57         CASE DEFAULT
58            CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' )
59         END SELECT
60      ENDDO
61
62   END SUBROUTINE bdy_dyn3d
63
64   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt )
65      !!----------------------------------------------------------------------
66      !!                  ***  SUBROUTINE bdy_dyn3d_frs  ***
67      !!
68      !! ** Purpose : - Apply the Flow Relaxation Scheme for baroclinic velocities
69      !!                at open boundaries.
70      !!
71      !! References :- Engedahl H., 1995: Use of the flow relaxation scheme in
72      !!               a three-dimensional baroclinic ocean model with realistic
73      !!               topography. Tellus, 365-382.
74      !!----------------------------------------------------------------------
75      INTEGER                     ::   kt
76      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
77      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
78      !!
79      INTEGER  ::   jb, jk         ! dummy loop indices
80      INTEGER  ::   ii, ij, igrd   ! local integers
81      REAL(wp) ::   zwgt           ! boundary weight
82      !!----------------------------------------------------------------------
83      !
84      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_frs')
85      !
86      igrd = 2                      ! Relaxation of zonal velocity
87      DO jb = 1, idx%nblen(igrd)
88         DO jk = 1, jpkm1
89            ii   = idx%nbi(jb,igrd)
90            ij   = idx%nbj(jb,igrd)
91            zwgt = idx%nbw(jb,igrd)
92            ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta%u3d(jb,jk) - ua(ii,ij,jk) ) ) * umask(ii,ij,jk)
93         END DO
94      END DO
95      !
96      igrd = 3                      ! Relaxation of meridional velocity
97      DO jb = 1, idx%nblen(igrd)
98         DO jk = 1, jpkm1
99            ii   = idx%nbi(jb,igrd)
100            ij   = idx%nbj(jb,igrd)
101            zwgt = idx%nbw(jb,igrd)
102            va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk)
103         END DO
104      END DO
105      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated
106      !
107      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
108
109      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs')
110
111   END SUBROUTINE bdy_dyn3d_frs
112
113
114#else
115   !!----------------------------------------------------------------------
116   !!   Dummy module                   NO Unstruct Open Boundary Conditions
117   !!----------------------------------------------------------------------
118CONTAINS
119   SUBROUTINE bdy_dyn3d( kt )      ! Empty routine
120      WRITE(*,*) 'bdy_dyn_frs: You should not have seen this print! error?', kt
121   END SUBROUTINE bdy_dyn3d
122#endif
123
124   !!======================================================================
125END MODULE bdydyn3d
Note: See TracBrowser for help on using the repository browser.