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.
obcdyn_bt.F90 in branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90 @ 2618

Last change on this file since 2618 was 2618, checked in by gm, 13 years ago

dynamic mem: #785 ; move dyn allocation from nemogcm to module when possible (continuation)
  • Property svn:keywords set to Id
File size: 13.7 KB
Line 
1MODULE obcdyn_bt
2#if ( defined key_dynspg_ts || defined key_dynspg_exp ) && defined key_obc
3   !!=================================================================================
4   !!                       ***  MODULE  obcdyn_bt  ***
5   !! Ocean dynamics:   Radiation/prescription of sea surface heights
6   !!                   on each open boundary
7   !!=================================================================================
8
9   !!---------------------------------------------------------------------------------
10   !!   obc_dyn_bt        : call the subroutine for each open boundary
11   !!   obc_dyn_bt_east   : Flather's algorithm at the east open boundary
12   !!   obc_dyn_bt_west   : Flather's algorithm at the west open boundary
13   !!   obc_dyn_bt_north  : Flather's algorithm at the north open boundary
14   !!   obc_dyn_bt_south  : Flather's algorithm at the south open boundary
15   !!----------------------------------------------------------------------------------
16
17   !!----------------------------------------------------------------------------------
18   USE oce             ! ocean dynamics and tracers
19   USE dom_oce         ! ocean space and time domain
20   USE phycst          ! physical constants
21   USE obc_oce         ! ocean open boundary conditions
22   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
23   USE lib_mpp         ! distributed memory computing
24   USE obcdta          ! ocean open boundary conditions
25   USE in_out_manager  ! I/O manager
26   USE dynspg_oce      ! surface pressure gradient     (free surface with time-splitting)
27
28   IMPLICIT NONE
29   PRIVATE
30
31   !! * Accessibility
32   PUBLIC obc_dyn_bt  ! routine called in dynnxt (explicit free surface case)
33
34   !!---------------------------------------------------------------------------------
35   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
36   !! $Id$
37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39
40CONTAINS
41
42   SUBROUTINE obc_dyn_bt( kt )
43      !!------------------------------------------------------------------------------
44      !!                      SUBROUTINE obc_dyn_bt
45      !!                     ***********************
46      !! ** Purpose :
47      !!      Apply Flather's algorithm at open boundaries for the explicit
48      !!      free surface case and free surface case with time-splitting
49      !!
50      !!      This routine is called in dynnxt.F routine and updates ua, va and sshn.
51      !!
52      !!      The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north,
53      !!      and/or lp_obc_south allow the user to determine which boundary is an
54      !!      open one (must be done in the param_obc.h90 file).
55      !!
56      !! ** Reference :   Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164
57      !!
58      !! History :  9.0  !  05-12  (V. Garnier) original
59      !!----------------------------------------------------------------------
60      !! * Arguments
61      INTEGER, INTENT( in ) ::   kt
62
63      !!----------------------------------------------------------------------
64
65      IF( lp_obc_east  )   CALL obc_dyn_bt_east 
66      IF( lp_obc_west  )   CALL obc_dyn_bt_west 
67      IF( lp_obc_north )   CALL obc_dyn_bt_north
68      IF( lp_obc_south )   CALL obc_dyn_bt_south
69
70      IF( lk_mpp ) THEN
71         IF( kt >= nit000+3 .AND. ln_rstart ) THEN
72            CALL lbc_lnk( sshb, 'T',  1. )
73            CALL lbc_lnk( ub  , 'U', -1. )
74            CALL lbc_lnk( vb  , 'V', -1. )
75         END IF
76         CALL lbc_lnk( sshn, 'T',  1. )
77         CALL lbc_lnk( ua  , 'U', -1. )
78         CALL lbc_lnk( va  , 'V', -1. )
79      ENDIF
80
81   END SUBROUTINE obc_dyn_bt
82
83# if defined key_dynspg_exp
84   SUBROUTINE obc_dyn_bt_east 
85      !!------------------------------------------------------------------------------
86      !!                  ***  SUBROUTINE obc_dyn_bt_east  ***
87      !!             
88      !! ** Purpose :
89      !!      Apply Flather's algorithm on east OBC velocities ua, va
90      !!      Fix sea surface height (sshn) on east open boundary
91      !!      The logical lfbceast must be .TRUE.
92      !!
93      !!  History :
94      !!   9.0  !  05-12  (V. Garnier) original
95      !!------------------------------------------------------------------------------
96      !! * Local declaration
97      INTEGER ::   ji, jj, jk ! dummy loop indices
98      !!------------------------------------------------------------------------------
99
100      DO ji = nie0, nie1
101         DO jk = 1, jpkm1
102            DO jj = 1, jpj
103               ua(ji,jj,jk) = ua(ji,jj,jk) + sqrt( grav*hur (ji,jj) )               &
104                  &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  &
105                  &                          - sshfoe(jj) ) * uemsk(jj,jk)
106            END DO
107         END DO
108      END DO
109      DO ji = nie0p1, nie1p1
110         DO jj = 1, jpj
111            sshn(ji,jj) = sshn(ji,jj) * (1.-temsk(jj,1)) + temsk(jj,1)*sshfoe(jj)
112         END DO
113      END DO
114
115   END SUBROUTINE obc_dyn_bt_east
116
117
118   SUBROUTINE obc_dyn_bt_west 
119      !!------------------------------------------------------------------------------
120      !!                  ***  SUBROUTINE obc_dyn_bt_west  ***
121      !!                 
122      !! ** Purpose :
123      !!      Apply Flather algorithm on west OBC velocities ua, va
124      !!      Fix sea surface height (sshn) on west open boundary
125      !!      The logical lfbcwest must be .TRUE.
126      !!
127      !!  History :
128      !!   9.0  !  05-12  (V. Garnier) original
129      !!------------------------------------------------------------------------------
130      !! * Local declaration
131      INTEGER ::   ji, jj, jk ! dummy loop indices
132      !!------------------------------------------------------------------------------
133
134      DO ji = niw0, niw1
135         DO jk = 1, jpkm1
136            DO jj = 1, jpj
137               ua(ji,jj,jk) = ua(ji,jj,jk) - sqrt( grav*hur (ji,jj) )               &
138                  &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  &
139                  &                          - sshfow(jj) ) * uwmsk(jj,jk)
140            END DO
141         END DO
142         DO jj = 1, jpj
143            sshn(ji,jj) = sshn(ji,jj) * (1.-twmsk(jj,1)) + twmsk(jj,1)*sshfow(jj)
144         END DO
145      END DO
146
147   END SUBROUTINE obc_dyn_bt_west
148
149   SUBROUTINE obc_dyn_bt_north 
150      !!------------------------------------------------------------------------------
151      !!                ***  SUBROUTINE obc_dyn_bt_north  ***
152      !!
153      !! ** Purpose :
154      !!      Apply Flather algorithm on north OBC velocities ua, va
155      !!      Fix sea surface height (sshn) on north open boundary
156      !!      The logical lfbcnorth must be .TRUE.
157      !!
158      !!  History :
159      !!   9.0  !  05-12  (V. Garnier) original
160      !!------------------------------------------------------------------------------
161      !! * Local declaration
162      INTEGER ::   ji, jj, jk ! dummy loop indices
163      !!------------------------------------------------------------------------------
164
165      DO jj = njn0, njn1
166         DO jk = 1, jpkm1
167            DO ji = 1, jpi
168               va(ji,jj,jk) = va(ji,jj,jk) + sqrt( grav*hvr (ji,jj) )               &
169                  &                      * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5  &
170                  &                          - sshfon(ji) ) * vnmsk(ji,jk)
171            END DO
172         END DO
173      END DO
174      DO jj = njn0p1, njn1p1
175         DO ji = 1, jpi
176            sshn(ji,jj)= sshn(ji,jj) * (1.-tnmsk(ji,1)) + sshfon(ji)*tnmsk(ji,1)
177         END DO
178      END DO
179
180   END SUBROUTINE obc_dyn_bt_north
181
182   SUBROUTINE obc_dyn_bt_south 
183      !!------------------------------------------------------------------------------
184      !!                ***  SUBROUTINE obc_dyn_bt_south  ***
185      !!                   
186      !! ** Purpose :
187      !!      Apply Flather algorithm on south OBC velocities ua, va
188      !!      Fix sea surface height (sshn) on south open boundary
189      !!      The logical lfbcsouth must be .TRUE.
190      !!
191      !!  History :
192      !!   9.0  !  05-12  (V. Garnier) original
193      !!------------------------------------------------------------------------------
194      !! * Local declaration
195      INTEGER ::   ji, jj, jk ! dummy loop indices
196
197      !!------------------------------------------------------------------------------
198
199      DO jj = njs0, njs1
200         DO jk = 1, jpkm1
201            DO ji = 1, jpi
202               va(ji,jj,jk) = va(ji,jj,jk) - sqrt( grav*hvr (ji,jj) )               &
203                  &                       * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5 &
204                  &                           - sshfos(ji) ) * vsmsk(ji,jk)
205            END DO
206         END DO
207         DO ji = 1, jpi
208            sshn(ji,jj)= sshn(ji,jj) * (1.-tsmsk(ji,1)) + tsmsk(ji,1) * sshfos(ji)
209         END DO
210      END DO
211
212   END SUBROUTINE obc_dyn_bt_south
213
214# elif defined key_dynspg_ts
215
216   SUBROUTINE obc_dyn_bt_east 
217      !!------------------------------------------------------------------------------
218      !!                  ***  SUBROUTINE obc_dyn_bt_east  ***
219      !!
220      !! ** Purpose :
221      !!      Apply Flather's algorithm on east OBC velocities ua, va
222      !!      Fix sea surface height (sshn) on east open boundary
223      !!      The logical lfbceast must be .TRUE.
224      !!
225      !!  History :
226      !!   9.0  !  05-12  (V. Garnier) original
227      !!------------------------------------------------------------------------------
228      !! * Local declaration
229      INTEGER ::   ji, jj, jk ! dummy loop indices
230      !!------------------------------------------------------------------------------
231
232      DO ji = nie0, nie1
233         DO jk = 1, jpkm1
234            DO jj = 1, jpj
235               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfoe_b(ji,jj) ) * uemsk(jj,jk)
236            END DO
237         END DO
238      END DO
239      DO ji = nie0p1, nie1p1
240         DO jj = 1, jpj
241            sshn(ji,jj) = sshn(ji,jj) * (1.-temsk(jj,1)) + temsk(jj,1)*sshn_b(ji,jj)
242         END DO
243      END DO
244
245   END SUBROUTINE obc_dyn_bt_east
246
247   SUBROUTINE obc_dyn_bt_west 
248      !!------------------------------------------------------------------------------
249      !!                  ***  SUBROUTINE obc_dyn_bt_west  ***
250      !!
251      !! ** Purpose :
252      !! ** Purpose :
253      !!      Apply Flather algorithm on west OBC velocities ua, va
254      !!      Fix sea surface height (sshn) on west open boundary
255      !!      The logical lfbcwest must be .TRUE.
256      !!
257      !!  History :
258      !!   9.0  !  05-12  (V. Garnier) original
259      !!------------------------------------------------------------------------------
260      !! * Local declaration
261      INTEGER ::   ji, jj, jk ! dummy loop indices
262      !!------------------------------------------------------------------------------
263
264      DO ji = niw0, niw1
265         DO jk = 1, jpkm1
266            DO jj = 1, jpj
267               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfow_b(ji,jj) ) * uwmsk(jj,jk)
268            END DO
269         END DO
270         DO jj = 1, jpj
271            sshn(ji,jj) = sshn(ji,jj) * (1.-twmsk(jj,1)) + twmsk(jj,1)*sshn_b(ji,jj)
272         END DO
273      END DO
274
275   END SUBROUTINE obc_dyn_bt_west
276
277   SUBROUTINE obc_dyn_bt_north 
278      !!------------------------------------------------------------------------------
279      !!                     SUBROUTINE obc_dyn_bt_north
280      !!                    *************************
281      !! ** Purpose :
282      !!      Apply Flather algorithm on north OBC velocities ua, va
283      !!      Fix sea surface height (sshn) on north open boundary
284      !!      The logical lfbcnorth must be .TRUE.
285      !!
286      !!  History :
287      !!   9.0  !  05-12  (V. Garnier) original
288      !!------------------------------------------------------------------------------
289      !! * Local declaration
290      INTEGER ::   ji, jj, jk ! dummy loop indices
291      !!------------------------------------------------------------------------------
292
293      DO jj = njn0, njn1
294         DO jk = 1, jpkm1
295            DO ji = 1, jpi
296               va(ji,jj,jk) = ( va(ji,jj,jk) + sshfon_b(ji,jj) ) * vnmsk(jj,jk)
297            END DO
298         END DO
299      END DO
300      DO jj = njn0p1, njn1p1
301         DO ji = 1, jpi
302            sshn(ji,jj)= sshn(ji,jj) * (1.-tnmsk(ji,1)) + sshn_b(ji,jj)*tnmsk(ji,1)
303         END DO
304      END DO
305
306   END SUBROUTINE obc_dyn_bt_north
307
308   SUBROUTINE obc_dyn_bt_south 
309      !!------------------------------------------------------------------------------
310      !!                     SUBROUTINE obc_dyn_bt_south
311      !!                    *************************
312      !! ** Purpose :
313      !!      Apply Flather algorithm on south OBC velocities ua, va
314      !!      Fix sea surface height (sshn) on south open boundary
315      !!      The logical lfbcsouth must be .TRUE.
316      !!
317      !!  History :
318      !!   9.0  !  05-12  (V. Garnier) original
319      !!------------------------------------------------------------------------------
320      INTEGER ::   ji, jj, jk ! dummy loop indices
321      !!------------------------------------------------------------------------------
322
323      DO jj = njs0, njs1
324         DO jk = 1, jpkm1
325            DO ji = 1, jpi
326               va(ji,jj,jk) = ( va(ji,jj,jk) + sshfos_b(ji,jj) ) * vsmsk(jj,jk)
327            END DO
328         END DO
329         DO ji = 1, jpi
330            sshn(ji,jj)= sshn(ji,jj) * (1.-tsmsk(ji,1)) + tsmsk(ji,1) * sshn_b(ji,jj)
331         END DO
332      END DO
333
334   END SUBROUTINE obc_dyn_bt_south
335
336# endif
337#else
338   !!=================================================================================
339   !!                       ***  MODULE  obcdyn_bt  ***
340   !! Ocean dynamics:   Radiation of velocities on each open boundary
341   !!=================================================================================
342CONTAINS
343
344   SUBROUTINE obc_dyn_bt
345                              ! No open boundaries ==> empty routine
346   END SUBROUTINE obc_dyn_bt
347#endif
348
349END MODULE obcdyn_bt
Note: See TracBrowser for help on using the repository browser.