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

Last change on this file since 3323 was 2415, checked in by gm, 14 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
RevLine 
[367]1MODULE obcfla
[2415]2   !!======================================================================
[367]3   !!                       ***  MODULE  obcfla  ***
4   !! Ocean dynamics:   Flather's algorithm at open boundaries for the time-splitting
[2415]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   !!----------------------------------------------------------------------
[367]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
[2415]19   !!----------------------------------------------------------------------
[367]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
[2415]30   PUBLIC   obc_fla_ts   ! routine called in dynspg_ts (free surface time splitting case)
[367]31
[2415]32   !!----------------------------------------------------------------------
[2287]33   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]34   !! $Id$
[2415]35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
[367]37CONTAINS
38
39   SUBROUTINE obc_fla_ts
[2415]40      !!----------------------------------------------------------------------
[367]41      !!                      SUBROUTINE obc_fla_ts
42      !!
[2415]43      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the
44      !!      time-splitting free surface case (barotropic variables)
45      !!
[374]46      !!      This routine is called in dynspg_ts.F90 routine
[367]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
[374]50      !!      open one (must be done in the obc_par.F90 file).
[367]51      !!
[2415]52      !! ** Reference : Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164
53      !!----------------------------------------------------------------------
54      !
[367]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
[2415]59      !
[367]60   END SUBROUTINE obc_fla_ts
61
62
63   SUBROUTINE obc_fla_ts_east
[2415]64      !!----------------------------------------------------------------------
[367]65      !!                  ***  SUBROUTINE obc_fla_ts_east  ***
66      !!
[2415]67      !! ** Purpose :   Apply Flather's algorithm on east OBC velocities ua, va
68      !!              Fix sea surface height (sshn_e) on east open boundary
69      !!----------------------------------------------------------------------
[2224]70      INTEGER ::   ji, jj ! dummy loop indices
[2415]71      !!----------------------------------------------------------------------
72      !
[367]73      DO ji = nie0, nie1
[2004]74         DO jj = 1, jpj
[2415]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)
[367]79         END DO
[2373]80      END DO
81      DO ji = nie0p1, nie1p1
[367]82         DO jj = 1, jpj
[2415]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)
[367]85         END DO
86      END DO
[2415]87      !
[367]88   END SUBROUTINE obc_fla_ts_east
89
90
91   SUBROUTINE obc_fla_ts_west
[2415]92      !!----------------------------------------------------------------------
[367]93      !!                  ***  SUBROUTINE obc_fla_ts_west  ***
94      !!
[2415]95      !! ** Purpose :   Apply Flather's algorithm on west OBC velocities ua, va
96      !!              Fix sea surface height (sshn_e) on west open boundary
97      !!----------------------------------------------------------------------
[2224]98      INTEGER ::   ji, jj ! dummy loop indices
[2415]99      !!----------------------------------------------------------------------
100      !
[367]101      DO ji = niw0, niw1
[2004]102         DO jj = 1, jpj
[2415]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)
[367]109         END DO
110      END DO
[2415]111      !
[367]112   END SUBROUTINE obc_fla_ts_west
113
[2415]114
[367]115   SUBROUTINE obc_fla_ts_north
[2415]116      !!----------------------------------------------------------------------
[367]117      !!                     SUBROUTINE obc_fla_ts_north
118      !!
[2415]119      !! ** Purpose :   Apply Flather's algorithm on north OBC velocities ua, va
120      !!              Fix sea surface height (sshn_e) on north open boundary
121      !!----------------------------------------------------------------------
[2224]122      INTEGER ::   ji, jj ! dummy loop indices
[2415]123      !!----------------------------------------------------------------------
124      !
[367]125      DO jj = njn0, njn1
[2004]126         DO ji = 1, jpi
[2415]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)
[2373]131         END DO
132      END DO
133      DO jj = njn0p1, njn1p1
134         DO ji = 1, jpi
[2415]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)
[367]137         END DO
138      END DO
[2415]139      !
[367]140   END SUBROUTINE obc_fla_ts_north
141
[2415]142
[367]143   SUBROUTINE obc_fla_ts_south
[2415]144      !!----------------------------------------------------------------------
[367]145      !!                     SUBROUTINE obc_fla_ts_south
146      !!
[2415]147      !! ** Purpose :   Apply Flather's algorithm on south OBC velocities ua, va
148      !!              Fix sea surface height (sshn_e) on south open boundary
149      !!----------------------------------------------------------------------
[2224]150      INTEGER ::   ji, jj ! dummy loop indices
[2415]151      !!----------------------------------------------------------------------
152      !
[367]153      DO jj = njs0, njs1
[2004]154         DO ji = 1, jpi
[2415]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)
[367]161         END DO
162      END DO
[2415]163      !
[367]164   END SUBROUTINE obc_fla_ts_south
[2415]165   
[367]166#else
[2415]167   !!----------------------------------------------------------------------
168   !!   Dummy module :                             No OBC or time-splitting
169   !!----------------------------------------------------------------------
[367]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
[2415]176   !!======================================================================
[367]177END MODULE obcfla
Note: See TracBrowser for help on using the repository browser.