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 branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90 @ 2415

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

v3.3beta: #548 correct a compilation error in obcfla.F90 + style changes

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