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.
obcfla.F90 in trunk/NEMO/OPA_SRC/OBC – NEMO

source: trunk/NEMO/OPA_SRC/OBC/obcfla.F90 @ 2270

Last change on this file since 2270 was 2270, checked in by rblod, 14 years ago

Correct a bug in obcfla, see ticket #736
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 9.3 KB
Line 
1MODULE obcfla
2#if defined key_obc && defined key_dynspg_ts
3   !!=================================================================================
4   !!                       ***  MODULE  obcfla  ***
5   !! Ocean dynamics:   Flather's algorithm at open boundaries for the time-splitting
6   !!=================================================================================
7
8   !!---------------------------------------------------------------------------------
9   !!   obc_fla_ts        : call the subroutine for each open boundary
10   !!   obc_fla_ts_east   : Flather on the east  open boundary velocities & ssh
11   !!   obc_fla_ts_west   : Flather on the west  open boundary velocities & ssh
12   !!   obc_fla_ts_north  : Flather on the north open boundary velocities & ssh
13   !!   obc_fla_ts_south  : Flather on the south open boundary velocities & ssh
14   !!----------------------------------------------------------------------------------
15
16   !!----------------------------------------------------------------------------------
17   !! * Modules used
18   USE oce             ! ocean dynamics and tracers
19   USE dom_oce         ! ocean space and time domain
20   USE dynspg_oce      ! surface pressure gradient variables
21   USE phycst          ! physical constants
22   USE obc_oce         ! ocean open boundary conditions
23   USE obcdta          ! ocean open boundary conditions: climatology
24
25   IMPLICIT NONE
26   PRIVATE
27
28   !! * Accessibility
29   PUBLIC obc_fla_ts  ! routine called in dynspg_ts (free surface time splitting case)
30
31   !!---------------------------------------------------------------------------------
32   !!  OPA 9.0 , LOCEAN-IPSL (2005)
33   !! $Id$
34   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
35   !!---------------------------------------------------------------------------------
36
37CONTAINS
38
39   SUBROUTINE obc_fla_ts
40      !!------------------------------------------------------------------------------
41      !!                      SUBROUTINE obc_fla_ts
42      !!                     **********************
43      !! ** Purpose :
44      !!      Apply Flather's algorithm at open boundaries for the time-splitting
45      !!      free surface case (barotropic variables)
46      !!
47      !!      This routine is called in dynspg_ts.F90 routine
48      !!
49      !!      The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north,
50      !!      and/or lp_obc_south allow the user to determine which boundary is an
51      !!      open one (must be done in the obc_par.F90 file).
52      !!
53      !! ** Reference :
54      !!         Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164
55      !!
56      !! History :
57      !!   9.0  !  05-12  (V. Garnier) original
58      !!------------------------------------------------------------------------------
59
60      IF( lp_obc_east  )   CALL obc_fla_ts_east 
61      IF( lp_obc_west  )   CALL obc_fla_ts_west 
62      IF( lp_obc_north )   CALL obc_fla_ts_north
63      IF( lp_obc_south )   CALL obc_fla_ts_south
64
65   END SUBROUTINE obc_fla_ts
66
67
68   SUBROUTINE obc_fla_ts_east
69      !!------------------------------------------------------------------------------
70      !!                  ***  SUBROUTINE obc_fla_ts_east  ***
71      !!
72      !! ** Purpose :
73      !!      Apply Flather's algorithm on east OBC velocities ua, va
74      !!      Fix sea surface height (sshn_e) on east open boundary
75      !!
76      !!  History :
77      !!   9.0  !  05-12  (V. Garnier) original
78      !!------------------------------------------------------------------------------
79      !! * Local declaration
80      INTEGER ::   ji, jj ! dummy loop indices
81      !!------------------------------------------------------------------------------
82
83      DO ji = nie0, nie1
84         DO jj = 1, jpj
85            ua_e(ji,jj) = (  ubtfoe(jj) * hur(ji,jj) + sqrt( grav*hur(ji,jj) )   &
86               &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5        &
87               &            - sshfoe(jj) )  ) * uemsk(jj,1)
88         END DO
89         DO jj = 1, jpj
90            sshfoe_b(ji,jj) = sshfoe_b(ji,jj) + sqrt( grav*hur(ji,jj) )     &
91               &             * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5  &
92               &                 - sshfoe(jj) ) * uemsk(jj,1)
93            ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - temsk(jj,1) ) &
94               &            + temsk(jj,1) * sshfoe(jj)
95            va_e(ji,jj) = vbtfoe(jj) * hvr(ji,jj) * uemsk(jj,1)
96         END DO
97      END DO
98
99   END SUBROUTINE obc_fla_ts_east
100
101
102   SUBROUTINE obc_fla_ts_west
103      !!------------------------------------------------------------------------------
104      !!                  ***  SUBROUTINE obc_fla_ts_west  ***
105      !!
106      !! ** Purpose :
107      !!      Apply Flather's algorithm on west OBC velocities ua, va
108      !!      Fix sea surface height (sshn_e) on west open boundary
109      !!
110      !!  History :
111      !!   9.0  !  05-12  (V. Garnier) original
112      !!------------------------------------------------------------------------------
113      !! * Local declaration
114      INTEGER ::   ji, jj ! dummy loop indices
115      !!------------------------------------------------------------------------------
116
117      DO ji = niw0, niw1
118         DO jj = 1, jpj
119            ua_e(ji,jj) = ( ubtfow(jj) * hur(ji,jj) - sqrt( grav * hur(ji,jj) )   &
120               &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5         &
121               &                - sshfow(jj) ) ) * uwmsk(jj,1)
122            va_e(ji,jj) = vbtfow(jj) * hvr(ji,jj) * uwmsk(jj,1)
123         END DO
124         DO jj = 1, jpj
125            sshfow_b(ji,jj) = sshfow_b(ji,jj) - sqrt( grav * hur(ji,jj) )     &
126                              * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5   &
127                                 - sshfow(jj) ) * uwmsk(jj,1)
128            ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - twmsk(jj,1) ) &
129               &            + twmsk(jj,1)*sshfow(jj)
130         END DO
131      END DO
132
133   END SUBROUTINE obc_fla_ts_west
134
135   SUBROUTINE obc_fla_ts_north
136      !!------------------------------------------------------------------------------
137      !!                     SUBROUTINE obc_fla_ts_north
138      !!                    *************************
139      !! ** Purpose :
140      !!      Apply Flather's algorithm on north OBC velocities ua, va
141      !!      Fix sea surface height (sshn_e) on north open boundary
142      !!
143      !!  History :
144      !!   9.0  !  05-12  (V. Garnier) original
145      !!------------------------------------------------------------------------------
146      !! * Local declaration
147      INTEGER ::   ji, jj ! dummy loop indices
148      !!------------------------------------------------------------------------------
149
150      DO jj = njn0, njn1
151         DO ji = 1, jpi
152            va_e(ji,jj) = ( vbtfon(ji) * hvr(ji,jj) + sqrt( grav * hvr(ji,jj) )   &
153               &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5         &
154               &                - sshfon(ji) ) ) * vnmsk(ji,1)
155         END DO
156         DO ji = 1, jpi
157            sshfon_b(ji,jj) = sshfon_b(ji,jj) + sqrt( grav * hvr(ji,jj) )  &
158               &              * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5    &
159               &                  - sshfon(ji) ) * vnmsk(ji,1)
160            ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - tnmsk(ji,1) ) &
161               &            + sshfon(ji) * tnmsk(ji,1)
162            ua_e(ji,jj) = ubtfon(ji) * hur(ji,jj) * vnmsk(ji,1)
163         END DO
164      END DO
165
166   END SUBROUTINE obc_fla_ts_north
167
168   SUBROUTINE obc_fla_ts_south
169      !!------------------------------------------------------------------------------
170      !!                     SUBROUTINE obc_fla_ts_south
171      !!                    *************************
172      !! ** Purpose :
173      !!      Apply Flather's algorithm on south OBC velocities ua, va
174      !!      Fix sea surface height (sshn_e) on south open boundary
175      !!
176      !!  History :
177      !!   9.0  !  05-12  (V. Garnier) original
178      !!------------------------------------------------------------------------------
179      !! * Local declaration
180      INTEGER ::   ji, jj ! dummy loop indices
181
182      !!------------------------------------------------------------------------------
183
184      DO jj = njs0, njs1
185         DO ji = 1, jpi
186            va_e(ji,jj) = ( vbtfos(ji) * hvr(ji,jj) - sqrt( grav * hvr(ji,jj) )   &
187               &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5         &
188               &                - sshfos(ji) ) ) * vsmsk(ji,1)
189            ua_e(ji,jj) = ubtfos(ji) * hur(ji,jj) * vsmsk(ji,1)
190         END DO
191         DO ji = 1, jpi
192            sshfos_b(ji,jj) = sshfos_b(ji,jj) - sqrt( grav * hvr(ji,jj) )      &
193               &              * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5    &
194               &                  - sshfos(ji) ) * vsmsk(ji,1)
195            ssha_e(ji,jj) = ssha_e(ji,jj) * (1. - tsmsk(ji,1) ) &
196               &            + tsmsk(ji,1) * sshfos(ji)
197         END DO
198      END DO
199
200   END SUBROUTINE obc_fla_ts_south
201#else
202   !!=================================================================================
203   !!                       ***  MODULE  obcfla  ***
204   !! Ocean dynamics:   Flather's algorithm at open boundaries for the time-splitting
205   !!=================================================================================
206CONTAINS
207
208   SUBROUTINE obc_fla_ts
209      WRITE(*,*) 'obc_fla_ts: You should not have seen this print! error?'
210   END SUBROUTINE obc_fla_ts
211#endif
212
213END MODULE obcfla
Note: See TracBrowser for help on using the repository browser.