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

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90 @ 4409

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