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 @ 2690

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

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation

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