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

source: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90 @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk
  • Property svn:keywords set to Id
File size: 10.1 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   !!----------------------------------------------------------------------
34   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
35   !! $Id$
36   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
37   !!----------------------------------------------------------------------
38CONTAINS
39
40   SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha )
41      !!----------------------------------------------------------------------
42      !!                      SUBROUTINE obc_fla_ts
43      !!
44      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the
45      !!      time-splitting 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 : Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164
54      !!----------------------------------------------------------------------
55      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
56      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
57      !!----------------------------------------------------------------------
58      !
59      IF( lp_obc_east  )   CALL obc_fla_ts_east ( pua, pva, p_sshn, p_ssha ) 
60      IF( lp_obc_west  )   CALL obc_fla_ts_west ( pua, pva, p_sshn, p_ssha )
61      IF( lp_obc_north )   CALL obc_fla_ts_north( pua, pva, p_sshn, p_ssha )
62      IF( lp_obc_south )   CALL obc_fla_ts_south( pua, pva, p_sshn, p_ssha ) 
63      !
64   END SUBROUTINE obc_fla_ts
65
66
67   SUBROUTINE obc_fla_ts_east( pua, pva, p_sshn, p_ssha ) 
68      !!----------------------------------------------------------------------
69      !!                  ***  SUBROUTINE obc_fla_ts_east  ***
70      !!
71      !! ** Purpose :   Apply Flather's algorithm on east OBC velocities ua, va
72      !!              Fix sea surface height (p_sshn) on east open boundary
73      !!----------------------------------------------------------------------
74      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
75      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
76      !
77      INTEGER ::   ji, jj   ! dummy loop indices
78      !!----------------------------------------------------------------------
79      !
80      DO ji = nie0, nie1
81         DO jj = 1, jpj
82            pua     (ji,jj) = (  ubtfoe(jj) * hur(ji,jj) + SQRT( grav*hur(ji,jj) )          &
83               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfoe(jj) )  ) * uemsk(jj,1)
84            sshfoe_b(ji,jj) =    sshfoe_b(ji,jj)         + SQRT( grav*hur(ji,jj) )          &
85               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfoe(jj) )    * uemsk(jj,1)
86         END DO
87      END DO
88      DO ji = nie0p1, nie1p1
89         DO jj = 1, jpj
90            p_ssha(ji,jj) = p_ssha(ji,jj) * ( 1. - temsk(jj,1) ) + temsk(jj,1) * sshfoe(jj)
91            pva   (ji,jj) = vbtfoe(jj) * hvr(ji,jj) * uemsk(jj,1)
92         END DO
93      END DO
94      !
95   END SUBROUTINE obc_fla_ts_east
96
97
98   SUBROUTINE obc_fla_ts_west( pua, pva, p_sshn, p_ssha )
99      !!----------------------------------------------------------------------
100      !!                  ***  SUBROUTINE obc_fla_ts_west  ***
101      !!
102      !! ** Purpose :   Apply Flather's algorithm on west OBC velocities ua, va
103      !!              Fix sea surface height (p_sshn) on west open boundary
104      !!----------------------------------------------------------------------
105      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
106      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
107      !
108      INTEGER ::   ji, jj   ! dummy loop indices
109      !!----------------------------------------------------------------------
110      !
111      DO ji = niw0, niw1
112         DO jj = 1, jpj
113            pua     (ji,jj) = ( ubtfow(jj) * hur(ji,jj) - sqrt( grav * hur(ji,jj) )            &
114               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfow(jj) ) ) * uwmsk(jj,1)
115            pva     (ji,jj) =   vbtfow(jj) * hvr(ji,jj) * uwmsk(jj,1)
116            sshfow_b(ji,jj) =   sshfow_b(ji,jj) - SQRT( grav * hur(ji,jj) )                    &
117               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfow(jj) )   * uwmsk(jj,1)
118            p_ssha  (ji,jj) = p_ssha(ji,jj) * ( 1. - twmsk(jj,1) ) + twmsk(jj,1)*sshfow(jj)
119         END DO
120      END DO
121      !
122   END SUBROUTINE obc_fla_ts_west
123
124
125   SUBROUTINE obc_fla_ts_north( pua, pva, p_sshn, p_ssha )
126      !!----------------------------------------------------------------------
127      !!                     SUBROUTINE obc_fla_ts_north
128      !!
129      !! ** Purpose :   Apply Flather's algorithm on north OBC velocities ua, va
130      !!              Fix sea surface height (p_sshn) on north open boundary
131      !!----------------------------------------------------------------------
132      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
133      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
134      !
135      INTEGER ::   ji, jj   ! dummy loop indices
136      !!----------------------------------------------------------------------
137      !
138      DO jj = njn0, njn1
139         DO ji = 1, jpi
140            pva     (ji,jj) = ( vbtfon(ji) * hvr(ji,jj) + sqrt( grav * hvr(ji,jj) )            &
141               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfon(ji) ) ) * vnmsk(ji,1)
142            sshfon_b(ji,jj) =   sshfon_b(ji,jj) + sqrt( grav * hvr(ji,jj) )                    &
143               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfon(ji) )   * vnmsk(ji,1)
144         END DO
145      END DO
146      DO jj = njn0p1, njn1p1
147         DO ji = 1, jpi
148            p_ssha(ji,jj) = p_ssha(ji,jj) * ( 1. - tnmsk(ji,1) ) + sshfon(ji) * tnmsk(ji,1)
149            pua   (ji,jj) = ubtfon(ji) * hur(ji,jj) * vnmsk(ji,1)
150         END DO
151      END DO
152      !
153   END SUBROUTINE obc_fla_ts_north
154
155
156   SUBROUTINE obc_fla_ts_south( pua, pva, p_sshn, p_ssha )
157      !!----------------------------------------------------------------------
158      !!                     SUBROUTINE obc_fla_ts_south
159      !!
160      !! ** Purpose :   Apply Flather's algorithm on south OBC velocities ua, va
161      !!              Fix sea surface height (p_sshn) on south open boundary
162      !!----------------------------------------------------------------------
163      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
164      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
165      !
166      INTEGER ::   ji, jj   ! dummy loop indices
167      !!----------------------------------------------------------------------
168      !
169      DO jj = njs0, njs1
170         DO ji = 1, jpi
171            pva     (ji,jj) = ( vbtfos(ji) * hvr(ji,jj) - sqrt( grav * hvr(ji,jj) )            &
172               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfos(ji) ) ) * vsmsk(ji,1)
173            pua     (ji,jj) =   ubtfos(ji) * hur(ji,jj) * vsmsk(ji,1)
174            sshfos_b(ji,jj) =   sshfos_b(ji,jj) - sqrt( grav * hvr(ji,jj) )                    &
175               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfos(ji) )   * vsmsk(ji,1)
176            p_ssha  (ji,jj) = p_ssha(ji,jj) * (1. - tsmsk(ji,1) ) + tsmsk(ji,1) * sshfos(ji)
177         END DO
178      END DO
179      !
180   END SUBROUTINE obc_fla_ts_south
181   
182#else
183   !!----------------------------------------------------------------------
184   !!   Dummy module :                             No OBC or time-splitting
185   !!----------------------------------------------------------------------
186CONTAINS
187   SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha )
188      REAL, DIMENSION(:,:)::   pua, pva, p_sshn, p_ssha
189      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)
190   END SUBROUTINE obc_fla_ts
191#endif
192   !!======================================================================
193END MODULE obcfla
Note: See TracBrowser for help on using the repository browser.