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 branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90 @ 4294

Last change on this file since 4294 was 4292, checked in by cetlod, 10 years ago

dev_MERGE_2013 : 1st step of the merge, see ticket #1185

  • Property svn:keywords set to Id
File size: 8.2 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#if defined key_bdy 
15   !!----------------------------------------------------------------------
16   !!   'key_bdy' :                    Unstructured Open Boundary Condition
17   !!----------------------------------------------------------------------
18   !!   bdy_dyn        : split velocities into barotropic and baroclinic parts
19   !!                    and call bdy_dyn2d and bdy_dyn3d to apply boundary
20   !!                    conditions
21   !!----------------------------------------------------------------------
22   USE wrk_nemo        ! Memory Allocation
23   USE timing          ! Timing
24   USE oce             ! ocean dynamics and tracers
25   USE dom_oce         ! ocean space and time domain
26   USE dynspg_oce     
27   USE bdy_oce         ! ocean open boundary conditions
28   USE bdydyn2d        ! open boundary conditions for barotropic solution
29   USE bdydyn3d        ! open boundary conditions for baroclinic velocities
30   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
31   USE in_out_manager  !
32   USE domvvl
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC   bdy_dyn     ! routine called in dynspg_flt (if lk_dynspg_flt) or
38                        ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp)
39
40#  include "domzgr_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
43   !! $Id$
44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE bdy_dyn( kt, dyn3d_only )
49      !!----------------------------------------------------------------------
50      !!                  ***  SUBROUTINE bdy_dyn  ***
51      !!
52      !! ** Purpose : - Wrapper routine for bdy_dyn2d and bdy_dyn3d.
53      !!
54      !!----------------------------------------------------------------------
55      !!
56      INTEGER, INTENT( in )           :: kt               ! Main time step counter
57      LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only       ! T => only update baroclinic velocities
58      !!
59      INTEGER               :: jk,ii,ij,ib_bdy,ib,igrd     ! Loop counter
60      LOGICAL               :: ll_dyn2d, ll_dyn3d, ll_orlanski
61      !!
62      REAL(wp), POINTER, DIMENSION(:,:) :: phur1, phvr1     ! inverse depth at u and v points
63
64      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn')
65
66      ll_dyn2d = .true.
67      ll_dyn3d = .true.
68
69      IF( PRESENT(dyn3d_only) ) THEN
70         IF( dyn3d_only ) ll_dyn2d = .false.
71      ENDIF
72
73      ll_orlanski = .false.
74      DO ib_bdy = 1, nb_bdy
75         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .or. cn_dyn2d(ib_bdy) == 'orlanski_npo' &
76     &   .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true.
77      ENDDO
78
79      !-------------------------------------------------------
80      ! Set pointers
81      !-------------------------------------------------------
82
83      pssh => sshn
84      phur => hur
85      phvr => hvr
86      CALL wrk_alloc(jpi,jpj,pua2d,pva2d) 
87      IF ( ll_orlanski ) CALL wrk_alloc(jpi,jpj,pub2d,pvb2d,phur1,phvr1) 
88
89      !-------------------------------------------------------
90      ! Split velocities into barotropic and baroclinic parts
91      !-------------------------------------------------------
92
93      ! "After" velocities:
94
95      pua2d(:,:) = 0.e0
96      pva2d(:,:) = 0.e0
97     
98      IF (lk_vvl) THEN
99         phur1(:,:) = 0.
100         phvr1(:,:) = 0.
101         DO jk = 1, jpkm1
102            phur1(:,:) = phur1(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk)
103            phvr1(:,:) = phvr1(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk)
104            pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk)
105            pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk)
106         END DO
107         phur1(:,:) = umask(:,:,1) / ( phur1(:,:) + 1. - umask(:,:,1) )
108         phvr1(:,:) = vmask(:,:,1) / ( phvr1(:,:) + 1. - vmask(:,:,1) )
109         pua2d(:,:) = pua2d(:,:) * phur1(:,:)
110         pva2d(:,:) = pva2d(:,:) * phvr1(:,:)
111      ELSE
112         DO jk = 1, jpkm1
113            pua2d(:,:) = pua2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk)
114            pva2d(:,:) = pva2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk)
115         END DO
116         pua2d(:,:) = pua2d(:,:) * phur(:,:)
117         pva2d(:,:) = pva2d(:,:) * phvr(:,:)
118      ENDIF
119
120      DO jk = 1 , jpkm1
121         ua(:,:,jk) = ua(:,:,jk) - pua2d(:,:)
122         va(:,:,jk) = va(:,:,jk) - pva2d(:,:)
123      END DO
124
125      ! "Before" velocities (required for Orlanski condition):
126
127      IF ( ll_orlanski ) THEN         
128         pub2d(:,:) = 0.e0
129         pvb2d(:,:) = 0.e0
130
131         IF (lk_vvl) THEN
132            phur1(:,:) = 0.
133            phvr1(:,:) = 0.
134            DO jk = 1, jpkm1   !! Vertically integrated momentum trends
135               phur1(:,:) = phur1(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)
136               phvr1(:,:) = phvr1(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)
137               pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) * ub(:,:,jk)
138               pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk)
139            END DO
140            phur1(:,:) = umask(:,:,1) / ( phur1(:,:) + 1. - umask(:,:,1) )
141            phvr1(:,:) = vmask(:,:,1) / ( phvr1(:,:) + 1. - vmask(:,:,1) )
142            pub2d(:,:) = pub2d(:,:) * phur1(:,:)
143            pvb2d(:,:) = pvb2d(:,:) * phvr1(:,:)
144         ELSE
145            DO jk = 1, jpkm1   !! Vertically integrated momentum trends
146               pub2d(:,:) = pub2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ub(:,:,jk)
147               pvb2d(:,:) = pvb2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk)
148            END DO
149            pub2d(:,:) = pub2d(:,:) * phur(:,:)
150            pvb2d(:,:) = pvb2d(:,:) * phvr(:,:)
151         ENDIF
152
153         DO jk = 1 , jpkm1
154            ub(:,:,jk) = ub(:,:,jk) - pub2d(:,:)
155            vb(:,:,jk) = vb(:,:,jk) - pvb2d(:,:)
156         END DO
157      END IF
158
159      !-------------------------------------------------------
160      ! Apply boundary conditions to barotropic and baroclinic
161      ! parts separately
162      !-------------------------------------------------------
163
164      IF( ll_dyn2d ) CALL bdy_dyn2d( kt )
165
166      IF( ll_dyn3d ) CALL bdy_dyn3d( kt )
167
168      !-------------------------------------------------------
169      ! Recombine velocities
170      !-------------------------------------------------------
171
172      DO jk = 1 , jpkm1
173         ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk)
174         va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk)
175      END DO
176
177      IF ( ll_orlanski ) THEN
178         DO jk = 1 , jpkm1
179            ub(:,:,jk) = ( ub(:,:,jk) + pub2d(:,:) ) * umask(:,:,jk)
180            vb(:,:,jk) = ( vb(:,:,jk) + pvb2d(:,:) ) * vmask(:,:,jk)
181         END DO
182      END IF
183
184      CALL wrk_dealloc(jpi,jpj,pua2d,pva2d) 
185      IF ( ll_orlanski ) CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d) 
186
187      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn')
188
189   END SUBROUTINE bdy_dyn
190
191#else
192   !!----------------------------------------------------------------------
193   !!   Dummy module                   NO Unstruct Open Boundary Conditions
194   !!----------------------------------------------------------------------
195CONTAINS
196   SUBROUTINE bdy_dyn( kt )      ! Empty routine
197      WRITE(*,*) 'bdy_dyn: You should not have seen this print! error?', kt
198   END SUBROUTINE bdy_dyn
199#endif
200
201   !!======================================================================
202END MODULE bdydyn
Note: See TracBrowser for help on using the repository browser.