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/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90 @ 4400

Last change on this file since 4400 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.
  • Property svn:keywords set to Id
File size: 14.2 KB
RevLine 
[367]1MODULE obcdyn_bt
[2715]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   !!----------------------------------------------------------------------
[1151]8#if ( defined key_dynspg_ts || defined key_dynspg_exp ) && defined key_obc
[2715]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   !!----------------------------------------------------------------------
[367]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
[2715]19   !!----------------------------------------------------------------------
[367]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
[2153]26   USE obcdta          ! ocean open boundary conditions
[367]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
[2715]33   PUBLIC   obc_dyn_bt  ! routine called in dynnxt (explicit free surface case)
[367]34
[3211]35   !! * Control permutation of array indices
36#  include "oce_ftrans.h90"
37#  include "dom_oce_ftrans.h90"
38#  include "obc_oce_ftrans.h90"
39
[2715]40   !!----------------------------------------------------------------------
[2528]41   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]42   !! $Id$
[2715]43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[367]44   !!----------------------------------------------------------------------
45CONTAINS
46
[2715]47   SUBROUTINE obc_dyn_bt( kt )
48      !!----------------------------------------------------------------------
49      !!                 ***  SUBROUTINE obc_dyn_bt  ***
[367]50      !!
[2715]51      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the explicit
52      !!              free surface case and free surface case with time-splitting
53      !!
[367]54      !!      This routine is called in dynnxt.F routine and updates ua, va and sshn.
55      !!
56      !!      The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north,
57      !!      and/or lp_obc_south allow the user to determine which boundary is an
58      !!      open one (must be done in the param_obc.h90 file).
59      !!
[2715]60      !! Reference :   Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164
[367]61      !!----------------------------------------------------------------------
[2715]62      INTEGER, INTENT(in) ::   kt
[367]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
[2715]84
[367]85   SUBROUTINE obc_dyn_bt_east 
[2715]86      !!----------------------------------------------------------------------
[367]87      !!                  ***  SUBROUTINE obc_dyn_bt_east  ***
88      !!             
89      !! ** Purpose :
90      !!      Apply Flather's algorithm on east OBC velocities ua, va
91      !!      Fix sea surface height (sshn) on east open boundary
92      !!      The logical lfbceast must be .TRUE.
[2715]93      !!----------------------------------------------------------------------
94      INTEGER, INTENT(in) ::   kt
95      !!----------------------------------------------------------------------
96      INTEGER ::   ji, jj, jk   ! dummy loop indices
97      !!----------------------------------------------------------------------
[367]98
[3211]99#if defined key_z_first
100      DO jj = 1, jpj
101         DO ji = nie0, nie1
102            DO jk = 1, jpkm1
103#else
[367]104      DO ji = nie0, nie1
105         DO jk = 1, jpkm1
106            DO jj = 1, jpj
[3211]107#endif
[367]108               ua(ji,jj,jk) = ua(ji,jj,jk) + sqrt( grav*hur (ji,jj) )               &
109                  &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  &
110                  &                          - sshfoe(jj) ) * uemsk(jj,jk)
111            END DO
112         END DO
113      END DO
114      DO ji = nie0p1, nie1p1
115         DO jj = 1, jpj
116            sshn(ji,jj) = sshn(ji,jj) * (1.-temsk(jj,1)) + temsk(jj,1)*sshfoe(jj)
117         END DO
118      END DO
119
120   END SUBROUTINE obc_dyn_bt_east
121
122
123   SUBROUTINE obc_dyn_bt_west 
[2715]124      !!----------------------------------------------------------------------
[367]125      !!                  ***  SUBROUTINE obc_dyn_bt_west  ***
126      !!                 
127      !! ** Purpose :
128      !!      Apply Flather algorithm on west OBC velocities ua, va
129      !!      Fix sea surface height (sshn) on west open boundary
130      !!      The logical lfbcwest must be .TRUE.
[2715]131      !!----------------------------------------------------------------------
132      INTEGER ::   ji, jj, jk   ! dummy loop indices
133      !!----------------------------------------------------------------------
134      !
[367]135      DO ji = niw0, niw1
[3211]136#if defined key_z_first
137         DO jj = 1, jpj
138            DO jk = 1, jpkm1
139#else
[367]140         DO jk = 1, jpkm1
141            DO jj = 1, jpj
[3211]142#endif
[367]143               ua(ji,jj,jk) = ua(ji,jj,jk) - sqrt( grav*hur (ji,jj) )               &
144                  &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  &
145                  &                          - sshfow(jj) ) * uwmsk(jj,jk)
146            END DO
147         END DO
148         DO jj = 1, jpj
149            sshn(ji,jj) = sshn(ji,jj) * (1.-twmsk(jj,1)) + twmsk(jj,1)*sshfow(jj)
150         END DO
151      END DO
[2715]152      !
[367]153   END SUBROUTINE obc_dyn_bt_west
154
[2715]155
[367]156   SUBROUTINE obc_dyn_bt_north 
157      !!------------------------------------------------------------------------------
158      !!                ***  SUBROUTINE obc_dyn_bt_north  ***
159      !!
160      !! ** Purpose :
161      !!      Apply Flather algorithm on north OBC velocities ua, va
162      !!      Fix sea surface height (sshn) on north open boundary
163      !!      The logical lfbcnorth must be .TRUE.
[2715]164      !!----------------------------------------------------------------------
165      INTEGER ::   ji, jj, jk   ! dummy loop indices
166      !!----------------------------------------------------------------------
167      !
[367]168      DO jj = njn0, njn1
[3211]169#if defined key_z_first
170         DO ji = 1, jpi
171            DO jk = 1, jpkm1
172#else
[367]173         DO jk = 1, jpkm1
174            DO ji = 1, jpi
[3211]175#endif
[367]176               va(ji,jj,jk) = va(ji,jj,jk) + sqrt( grav*hvr (ji,jj) )               &
177                  &                      * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5  &
178                  &                          - sshfon(ji) ) * vnmsk(ji,jk)
179            END DO
180         END DO
181      END DO
182      DO jj = njn0p1, njn1p1
183         DO ji = 1, jpi
184            sshn(ji,jj)= sshn(ji,jj) * (1.-tnmsk(ji,1)) + sshfon(ji)*tnmsk(ji,1)
185         END DO
186      END DO
[2715]187      !
[367]188   END SUBROUTINE obc_dyn_bt_north
189
[2715]190
[367]191   SUBROUTINE obc_dyn_bt_south 
[2715]192      !!----------------------------------------------------------------------
[367]193      !!                ***  SUBROUTINE obc_dyn_bt_south  ***
194      !!                   
195      !! ** Purpose :
196      !!      Apply Flather algorithm on south OBC velocities ua, va
197      !!      Fix sea surface height (sshn) on south open boundary
198      !!      The logical lfbcsouth must be .TRUE.
[2715]199      !!----------------------------------------------------------------------
200      INTEGER ::   ji, jj, jk   ! dummy loop indices
201      !!----------------------------------------------------------------------
202      !
[367]203      DO jj = njs0, njs1
[3211]204#if defined key_z_first
205         DO ji = 1, jpi
206            DO jk = 1, jpkm1
207#else
[367]208         DO jk = 1, jpkm1
209            DO ji = 1, jpi
[3211]210#endif
[367]211               va(ji,jj,jk) = va(ji,jj,jk) - sqrt( grav*hvr (ji,jj) )               &
212                  &                       * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5 &
213                  &                           - sshfos(ji) ) * vsmsk(ji,jk)
214            END DO
215         END DO
216         DO ji = 1, jpi
217            sshn(ji,jj)= sshn(ji,jj) * (1.-tsmsk(ji,1)) + tsmsk(ji,1) * sshfos(ji)
218         END DO
219      END DO
[2715]220      !
[367]221   END SUBROUTINE obc_dyn_bt_south
222
223# elif defined key_dynspg_ts
224
225   SUBROUTINE obc_dyn_bt_east 
226      !!------------------------------------------------------------------------------
227      !!                  ***  SUBROUTINE obc_dyn_bt_east  ***
228      !!
229      !! ** Purpose :
230      !!      Apply Flather's algorithm on east OBC velocities ua, va
231      !!      Fix sea surface height (sshn) on east open boundary
232      !!      The logical lfbceast must be .TRUE.
[2715]233      !!----------------------------------------------------------------------
234      INTEGER ::   ji, jj, jk   ! dummy loop indices
235      !!----------------------------------------------------------------------
236      !
[3211]237#if defined key_z_first
238      DO jj = 1, jpj
239         DO ji = nie0, nie1
240             DO jk = 1, jpkm1
241#else
[367]242      DO ji = nie0, nie1
243         DO jk = 1, jpkm1
244            DO jj = 1, jpj
[3211]245#endif
[367]246               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfoe_b(ji,jj) ) * uemsk(jj,jk)
247            END DO
248         END DO
249      END DO
[3211]250#if defined key_z_first
251      DO jj = 1, jpj
252         DO ji = nie0p1, nie1p1
253#else
[367]254      DO ji = nie0p1, nie1p1
255         DO jj = 1, jpj
[3211]256#endif
[367]257            sshn(ji,jj) = sshn(ji,jj) * (1.-temsk(jj,1)) + temsk(jj,1)*sshn_b(ji,jj)
258         END DO
259      END DO
[2715]260      !
[367]261   END SUBROUTINE obc_dyn_bt_east
262
[2715]263
[367]264   SUBROUTINE obc_dyn_bt_west 
[2715]265      !!---------------------------------------------------------------------
[367]266      !!                  ***  SUBROUTINE obc_dyn_bt_west  ***
267      !!
[2715]268      !! ** Purpose :   Apply Flather algorithm on west OBC velocities ua, va
[367]269      !!      Fix sea surface height (sshn) on west open boundary
270      !!      The logical lfbcwest must be .TRUE.
[2715]271      !!----------------------------------------------------------------------
272      INTEGER ::   ji, jj, jk   ! dummy loop indices
273      !!----------------------------------------------------------------------
274      !
[3211]275#if defined key_z_first
276      DO jj = 1, jpj
277         DO ji = niw0, niw1
278            DO jk = 1, jpkm1
279               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfow_b(ji,jj) ) * uwmsk(jj,jk)
280            END DO
281         END DO
282      END DO
283      DO jj = 1, jpj
284         DO ji = niw0, niw1
285            sshn(ji,jj) = sshn(ji,jj) * (1.-twmsk(jj,1)) + twmsk(jj,1)*sshn_b(ji,jj)
286         END DO
287      END DO
288#else
[367]289      DO ji = niw0, niw1
290         DO jk = 1, jpkm1
291            DO jj = 1, jpj
292               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfow_b(ji,jj) ) * uwmsk(jj,jk)
293            END DO
294         END DO
295         DO jj = 1, jpj
296            sshn(ji,jj) = sshn(ji,jj) * (1.-twmsk(jj,1)) + twmsk(jj,1)*sshn_b(ji,jj)
297         END DO
298      END DO
[3211]299#endif
[2715]300      !
[367]301   END SUBROUTINE obc_dyn_bt_west
302
[2715]303
[367]304   SUBROUTINE obc_dyn_bt_north 
305      !!------------------------------------------------------------------------------
[2715]306      !!                ***  SUBROUTINE obc_dyn_bt_north  ***
307      !!               
[367]308      !! ** Purpose :
309      !!      Apply Flather algorithm on north OBC velocities ua, va
310      !!      Fix sea surface height (sshn) on north open boundary
311      !!      The logical lfbcnorth must be .TRUE.
[2715]312      !!----------------------------------------------------------------------
313      INTEGER ::   ji, jj, jk   ! dummy loop indices
314      !!----------------------------------------------------------------------
315      !
[3211]316#if defined key_z_first
[367]317      DO jj = njn0, njn1
[3211]318         DO ji = 1, jpi
319            DO jk = 1, jpkm1
320#else
321      DO jj = njn0, njn1
[367]322         DO jk = 1, jpkm1
323            DO ji = 1, jpi
[3211]324#endif
[367]325               va(ji,jj,jk) = ( va(ji,jj,jk) + sshfon_b(ji,jj) ) * vnmsk(jj,jk)
326            END DO
327         END DO
328      END DO
329      DO jj = njn0p1, njn1p1
330         DO ji = 1, jpi
331            sshn(ji,jj)= sshn(ji,jj) * (1.-tnmsk(ji,1)) + sshn_b(ji,jj)*tnmsk(ji,1)
332         END DO
333      END DO
[2715]334      !
[367]335   END SUBROUTINE obc_dyn_bt_north
336
[2715]337
[367]338   SUBROUTINE obc_dyn_bt_south 
339      !!------------------------------------------------------------------------------
[2715]340      !!                ***  SUBROUTINE obc_dyn_bt_south  ***
341      !!                 
[367]342      !! ** Purpose :
343      !!      Apply Flather algorithm on south OBC velocities ua, va
344      !!      Fix sea surface height (sshn) on south open boundary
345      !!      The logical lfbcsouth must be .TRUE.
[2715]346      !!----------------------------------------------------------------------
347      INTEGER ::   ji, jj, jk   ! dummy loop indices
348      !!----------------------------------------------------------------------
349      !
[367]350      DO jj = njs0, njs1
[3211]351#if defined key_z_first
352         DO ji = 1, jpi
353            DO jk = 1, jpkm1
354#else
[367]355         DO jk = 1, jpkm1
356            DO ji = 1, jpi
[3211]357#endif
[367]358               va(ji,jj,jk) = ( va(ji,jj,jk) + sshfos_b(ji,jj) ) * vsmsk(jj,jk)
359            END DO
360         END DO
361         DO ji = 1, jpi
362            sshn(ji,jj)= sshn(ji,jj) * (1.-tsmsk(ji,1)) + tsmsk(ji,1) * sshn_b(ji,jj)
363         END DO
364      END DO
[2715]365      !
[367]366   END SUBROUTINE obc_dyn_bt_south
367
368# endif
[2715]369
[367]370#else
[2715]371   !!----------------------------------------------------------------------
372   !!   Default option       No Open Boundaries or not explicit fre surface
373   !!----------------------------------------------------------------------
[367]374CONTAINS
[2715]375   SUBROUTINE obc_dyn_bt      ! Dummy routine
[367]376   END SUBROUTINE obc_dyn_bt
377#endif
378
[2715]379   !!======================================================================
[367]380END MODULE obcdyn_bt
Note: See TracBrowser for help on using the repository browser.