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

Last change on this file since 3275 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
RevLine 
[367]1MODULE obcfla
[2479]2   !!======================================================================
[367]3   !!                       ***  MODULE  obcfla  ***
4   !! Ocean dynamics:   Flather's algorithm at open boundaries for the time-splitting
[2479]5   !!======================================================================
6   !! History :  2.0  ! 2005-12  (V. Garnier) original code
[2715]7   !!            3.3  ! 2010-11  (G. Madec)
8   !!            4.0  ! 2011-02  (G. Madec) velocity & ssh passed in argument
[2479]9   !!----------------------------------------------------------------------
[2715]10#if defined key_obc   &&   defined key_dynspg_ts
[2479]11   !!----------------------------------------------------------------------
12   !!   'key_obc'          and                      Open Boundary Condition
13   !!   'key_dynspg_ts'                    free surface with time splitting
14   !!----------------------------------------------------------------------
[367]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
[2479]20   !!----------------------------------------------------------------------
[367]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
[2479]31   PUBLIC   obc_fla_ts   ! routine called in dynspg_ts (free surface time splitting case)
[367]32
[2479]33   !!----------------------------------------------------------------------
[2715]34   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
[1152]35   !! $Id$
[2479]36   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
37   !!----------------------------------------------------------------------
[367]38CONTAINS
39
[2715]40   SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha )
[2479]41      !!----------------------------------------------------------------------
[367]42      !!                      SUBROUTINE obc_fla_ts
43      !!
[2479]44      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the
45      !!      time-splitting free surface case (barotropic variables)
46      !!
[374]47      !!      This routine is called in dynspg_ts.F90 routine
[367]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
[374]51      !!      open one (must be done in the obc_par.F90 file).
[367]52      !!
[2479]53      !! ** Reference : Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164
54      !!----------------------------------------------------------------------
[2715]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      !!----------------------------------------------------------------------
[2479]58      !
[2715]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 ) 
[2479]63      !
[367]64   END SUBROUTINE obc_fla_ts
65
66
[2715]67   SUBROUTINE obc_fla_ts_east( pua, pva, p_sshn, p_ssha ) 
[2479]68      !!----------------------------------------------------------------------
[367]69      !!                  ***  SUBROUTINE obc_fla_ts_east  ***
70      !!
[2479]71      !! ** Purpose :   Apply Flather's algorithm on east OBC velocities ua, va
[2715]72      !!              Fix sea surface height (p_sshn) on east open boundary
[2479]73      !!----------------------------------------------------------------------
[2715]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
[2479]78      !!----------------------------------------------------------------------
79      !
[367]80      DO ji = nie0, nie1
[1941]81         DO jj = 1, jpj
[2715]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)
[2479]84            sshfoe_b(ji,jj) =    sshfoe_b(ji,jj)         + SQRT( grav*hur(ji,jj) )          &
[2715]85               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfoe(jj) )    * uemsk(jj,1)
[367]86         END DO
[2374]87      END DO
88      DO ji = nie0p1, nie1p1
[367]89         DO jj = 1, jpj
[2715]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)
[367]92         END DO
93      END DO
[2479]94      !
[367]95   END SUBROUTINE obc_fla_ts_east
96
97
[2715]98   SUBROUTINE obc_fla_ts_west( pua, pva, p_sshn, p_ssha )
[2479]99      !!----------------------------------------------------------------------
[367]100      !!                  ***  SUBROUTINE obc_fla_ts_west  ***
101      !!
[2479]102      !! ** Purpose :   Apply Flather's algorithm on west OBC velocities ua, va
[2715]103      !!              Fix sea surface height (p_sshn) on west open boundary
[2479]104      !!----------------------------------------------------------------------
[2715]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
[2479]109      !!----------------------------------------------------------------------
110      !
[367]111      DO ji = niw0, niw1
[1941]112         DO jj = 1, jpj
[2715]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)
[2479]116            sshfow_b(ji,jj) =   sshfow_b(ji,jj) - SQRT( grav * hur(ji,jj) )                    &
[2715]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)
[367]119         END DO
120      END DO
[2479]121      !
[367]122   END SUBROUTINE obc_fla_ts_west
123
[2479]124
[2715]125   SUBROUTINE obc_fla_ts_north( pua, pva, p_sshn, p_ssha )
[2479]126      !!----------------------------------------------------------------------
[367]127      !!                     SUBROUTINE obc_fla_ts_north
128      !!
[2479]129      !! ** Purpose :   Apply Flather's algorithm on north OBC velocities ua, va
[2715]130      !!              Fix sea surface height (p_sshn) on north open boundary
[2479]131      !!----------------------------------------------------------------------
[2715]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
[2479]136      !!----------------------------------------------------------------------
137      !
[367]138      DO jj = njn0, njn1
[1941]139         DO ji = 1, jpi
[2715]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)
[2479]142            sshfon_b(ji,jj) =   sshfon_b(ji,jj) + sqrt( grav * hvr(ji,jj) )                    &
[2715]143               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfon(ji) )   * vnmsk(ji,1)
[2374]144         END DO
145      END DO
146      DO jj = njn0p1, njn1p1
147         DO ji = 1, jpi
[2715]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)
[367]150         END DO
151      END DO
[2479]152      !
[367]153   END SUBROUTINE obc_fla_ts_north
154
[2479]155
[2715]156   SUBROUTINE obc_fla_ts_south( pua, pva, p_sshn, p_ssha )
[2479]157      !!----------------------------------------------------------------------
[367]158      !!                     SUBROUTINE obc_fla_ts_south
159      !!
[2479]160      !! ** Purpose :   Apply Flather's algorithm on south OBC velocities ua, va
[2715]161      !!              Fix sea surface height (p_sshn) on south open boundary
[2479]162      !!----------------------------------------------------------------------
[2715]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
[2479]167      !!----------------------------------------------------------------------
168      !
[367]169      DO jj = njs0, njs1
[1941]170         DO ji = 1, jpi
[2715]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)
[2479]174            sshfos_b(ji,jj) =   sshfos_b(ji,jj) - sqrt( grav * hvr(ji,jj) )                    &
[2715]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)
[367]177         END DO
178      END DO
[2479]179      !
[367]180   END SUBROUTINE obc_fla_ts_south
[2479]181   
[367]182#else
[2479]183   !!----------------------------------------------------------------------
184   !!   Dummy module :                             No OBC or time-splitting
185   !!----------------------------------------------------------------------
[367]186CONTAINS
[2715]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)
[367]190   END SUBROUTINE obc_fla_ts
191#endif
[2479]192   !!======================================================================
[367]193END MODULE obcfla
Note: See TracBrowser for help on using the repository browser.