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.
bdydyn.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/BDY – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/BDY/bdydyn.F90 @ 11480

Last change on this file since 11480 was 11480, checked in by davestorkey, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Merge in changes from branch of branch.
Main changes:

  1. "nxt" modules renamed as "atf" and now just do Asselin time filtering. The time level swapping is achieved by swapping indices.
  2. Some additional prognostic grid variables changed to use a time dimension.

Notes:

  1. This merged branch passes SETTE tests but does not identical results to the SETTE tests with the trunk@10721 unless minor bugs to do with Euler timestepping and the OFF timestepping are fixed in the trunk (NEMO tickets #2310 and #2311).
  2. The nn_dttrc > 1 option for TOP (TOP has a different timestep to OCE) doesn't work. But it doesn't work in the trunk or NEMO 4.0 release either.
  • Property svn:keywords set to Id
File size: 5.7 KB
Line 
1MODULE bdydyn
2   !!======================================================================
3   !!                       ***  MODULE  bdydyn  ***
4   !! Unstructured Open Boundary Cond. :   Apply boundary conditions to velocities
5   !!======================================================================
6   !! History :  1.0  !  2005-02  (J. Chanut, A. Sellar)  Original code
7   !!             -   !  2007-07  (D. Storkey) Move Flather implementation to separate routine.
8   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
9   !!            3.2  !  2008-04  (R. Benshila) consider velocity instead of transport
10   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations
11   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
12   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
13   !!----------------------------------------------------------------------
14   !!   bdy_dyn        : split velocities into barotropic and baroclinic parts
15   !!                    and call bdy_dyn2d and bdy_dyn3d to apply boundary
16   !!                    conditions
17   !!----------------------------------------------------------------------
18   USE oce             ! ocean dynamics and tracers
19   USE dom_oce         ! ocean space and time domain
20   USE bdy_oce         ! ocean open boundary conditions
21   USE bdydyn2d        ! open boundary conditions for barotropic solution
22   USE bdydyn3d        ! open boundary conditions for baroclinic velocities
23   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
24   USE in_out_manager  !
25   USE domvvl          ! variable volume
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   bdy_dyn    ! routine called in dyn_nxt
31
32   !!----------------------------------------------------------------------
33   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
34   !! $Id$
35   !! Software governed by the CeCILL license (see ./LICENSE)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE bdy_dyn( kt, Kbb, puu, pvv, Kaa, dyn3d_only )
40      !!----------------------------------------------------------------------
41      !!                  ***  SUBROUTINE bdy_dyn  ***
42      !!
43      !! ** Purpose : - Wrapper routine for bdy_dyn2d and bdy_dyn3d.
44      !!
45      !!----------------------------------------------------------------------
46      INTEGER                             , INTENT(in)    ::   kt           ! Main time step counter
47      INTEGER                             , INTENT(in)    ::   Kbb, Kaa     ! Ocean time level indices
48      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv     ! Ocean velocities (to be updated at open boundaries)
49      LOGICAL, OPTIONAL                   , INTENT(in)    ::   dyn3d_only   ! T => only update baroclinic velocities
50      !
51      INTEGER ::   jk, ii, ij, ib_bdy, ib, igrd     ! Loop counter
52      LOGICAL ::   ll_dyn2d, ll_dyn3d, ll_orlanski
53      REAL(wp), DIMENSION(jpi,jpj) :: zua2d, zva2d     ! after barotropic velocities
54      !!----------------------------------------------------------------------
55      !
56      ll_dyn2d = .true.
57      ll_dyn3d = .true.
58      !
59      IF( PRESENT(dyn3d_only) ) THEN
60         IF( dyn3d_only )   ll_dyn2d = .false.
61      ENDIF
62      !
63      ll_orlanski = .false.
64      DO ib_bdy = 1, nb_bdy
65         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .OR. cn_dyn2d(ib_bdy) == 'orlanski_npo' &
66     &   .OR. cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo')   ll_orlanski = .true.
67      END DO
68
69      !-------------------------------------------------------
70      ! Split velocities into barotropic and baroclinic parts
71      !-------------------------------------------------------
72
73      !                          ! "After" velocities:
74      zua2d(:,:) = 0._wp
75      zva2d(:,:) = 0._wp     
76      DO jk = 1, jpkm1
77         zua2d(:,:) = zua2d(:,:) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)
78         zva2d(:,:) = zva2d(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)
79      END DO
80      zua2d(:,:) = zua2d(:,:) * r1_hu(:,:,Kaa)
81      zva2d(:,:) = zva2d(:,:) * r1_hv(:,:,Kaa)
82
83      DO jk = 1 , jpkm1
84         puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - zua2d(:,:) ) * umask(:,:,jk)
85         pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - zva2d(:,:) ) * vmask(:,:,jk)
86      END DO
87
88
89      IF( ll_orlanski ) THEN     ! "Before" velocities (Orlanski condition only)
90         DO jk = 1 , jpkm1
91            puu(:,:,jk,Kbb) = ( puu(:,:,jk,Kbb) - uu_b(:,:,Kbb) ) * umask(:,:,jk)
92            pvv(:,:,jk,Kbb) = ( pvv(:,:,jk,Kbb) - vv_b(:,:,Kbb) ) * vmask(:,:,jk)
93         END DO
94      ENDIF
95
96      !-------------------------------------------------------
97      ! Apply boundary conditions to barotropic and baroclinic
98      ! parts separately
99      !-------------------------------------------------------
100
101      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu(:,:,Kaa), r1_hv(:,:,Kaa), ssh(:,:,Kaa) )
102
103      IF( ll_dyn3d )   CALL bdy_dyn3d( kt, Kbb, puu, pvv, Kaa )
104
105      !-------------------------------------------------------
106      ! Recombine velocities
107      !-------------------------------------------------------
108      !
109      DO jk = 1 , jpkm1
110         puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) + zua2d(:,:) ) * umask(:,:,jk)
111         pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) + zva2d(:,:) ) * vmask(:,:,jk)
112      END DO
113      !
114      IF ( ll_orlanski ) THEN
115         DO jk = 1 , jpkm1
116            puu(:,:,jk,Kbb) = ( puu(:,:,jk,Kbb) + uu_b(:,:,Kbb) ) * umask(:,:,jk)
117            pvv(:,:,jk,Kbb) = ( pvv(:,:,jk,Kbb) + vv_b(:,:,Kbb) ) * vmask(:,:,jk)
118         END DO
119      END IF
120      !
121   END SUBROUTINE bdy_dyn
122
123   !!======================================================================
124END MODULE bdydyn
Note: See TracBrowser for help on using the repository browser.