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.
bdydyn3d.F90 in NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/BDY – NEMO

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/BDY/bdydyn3d.F90 @ 13247

Last change on this file since 13247 was 13247, checked in by francesca, 4 years ago

dev_r12558_HPC-08_epico_Extra_Halo: merge with trunk@13227, see #2366
  • Property svn:keywords set to Id
File size: 21.0 KB
RevLine 
[3117]1MODULE bdydyn3d
2   !!======================================================================
[3182]3   !!                       ***  MODULE  bdydyn3d  ***
[3191]4   !! Unstructured Open Boundary Cond. :   Flow relaxation scheme on baroclinic velocities
[3117]5   !!======================================================================
[3191]6   !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite
[3680]7   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
[3117]8   !!----------------------------------------------------------------------
9   !!   bdy_dyn3d        : apply open boundary conditions to baroclinic velocities
10   !!   bdy_dyn3d_frs    : apply Flow Relaxation Scheme
11   !!----------------------------------------------------------------------
[3182]12   USE timing          ! Timing
[3117]13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE bdy_oce         ! ocean open boundary conditions
[4292]16   USE bdylib          ! for orlanski library routines
[3117]17   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
18   USE in_out_manager  !
[10529]19   USE lib_mpp, ONLY: ctl_stop
[3651]20   Use phycst
[3117]21
22   IMPLICIT NONE
23   PRIVATE
24
[3191]25   PUBLIC   bdy_dyn3d     ! routine called by bdy_dyn
[3651]26   PUBLIC   bdy_dyn3d_dmp ! routine called by step
[3117]27
28   !!----------------------------------------------------------------------
[9598]29   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5215]30   !! $Id$
[10068]31   !! Software governed by the CeCILL license (see ./LICENSE)
[3117]32   !!----------------------------------------------------------------------
33CONTAINS
34
[12377]35   SUBROUTINE bdy_dyn3d( kt, Kbb, puu, pvv, Kaa )
[3117]36      !!----------------------------------------------------------------------
37      !!                  ***  SUBROUTINE bdy_dyn3d  ***
38      !!
39      !! ** Purpose : - Apply open boundary conditions for baroclinic velocities
40      !!
41      !!----------------------------------------------------------------------
[12377]42      INTEGER                             , INTENT( in    ) ::   kt        ! Main time step counter
43      INTEGER                             , INTENT( in    ) ::   Kbb, Kaa  ! Time level indices
44      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
[6140]45      !
[11536]46      INTEGER  ::   ib_bdy, ir     ! BDY set index, rim index
47      LOGICAL  ::   llrim0         ! indicate if rim 0 is treated
48      LOGICAL, DIMENSION(4) :: llsend2, llrecv2, llsend3, llrecv3  ! indicate how communications are to be carried out
49
[6140]50      !!----------------------------------------------------------------------
[11536]51      llsend2(:) = .false.   ;   llrecv2(:) = .false.
52      llsend3(:) = .false.   ;   llrecv3(:) = .false.
53      DO ir = 1, 0, -1   ! treat rim 1 before rim 0
54         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE.
55         ELSE                 ;   llrim0 = .FALSE.
56         END IF
57         DO ib_bdy=1, nb_bdy
58            !
59            SELECT CASE( cn_dyn3d(ib_bdy) )
60            CASE('none')        ;   CYCLE
61            CASE('frs' )        ! treat the whole boundary at once
[12377]62                       IF( ir == 0) CALL bdy_dyn3d_frs( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
[11536]63            CASE('specified')   ! treat the whole rim      at once
[12377]64                       IF( ir == 0) CALL bdy_dyn3d_spe( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
[11536]65            CASE('zero')        ! treat the whole rim      at once
[12377]66                       IF( ir == 0) CALL bdy_dyn3d_zro( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
67            CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.false. )
68            CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.true.  )
69            CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy, llrim0 )
70            CASE('neumann')     ;   CALL bdy_dyn3d_nmn( puu, pvv, Kaa, idx_bdy(ib_bdy), ib_bdy, llrim0 )
[11536]71            CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' )
72            END SELECT
73         END DO
[6140]74         !
[11536]75         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0
76         IF( nn_hls == 1 ) THEN
77            llsend2(:) = .false.   ;   llrecv2(:) = .false.
78            llsend3(:) = .false.   ;   llrecv3(:) = .false.
79         END IF
80         DO ib_bdy=1, nb_bdy
81            SELECT CASE( cn_dyn3d(ib_bdy) )
82            CASE('orlanski', 'orlanski_npo')
83               llsend2(:) = llsend2(:) .OR. lsend_bdy(ib_bdy,2,:,ir)   ! possibly every direction, U points
84               llrecv2(:) = llrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:,ir)   ! possibly every direction, U points
85               llsend3(:) = llsend3(:) .OR. lsend_bdy(ib_bdy,3,:,ir)   ! possibly every direction, V points
86               llrecv3(:) = llrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:,ir)   ! possibly every direction, V points
87            CASE('zerograd')
88               llsend2(3:4) = llsend2(3:4) .OR. lsend_bdyint(ib_bdy,2,3:4,ir)   ! north/south, U points
89               llrecv2(3:4) = llrecv2(3:4) .OR. lrecv_bdyint(ib_bdy,2,3:4,ir)   ! north/south, U points
90               llsend3(1:2) = llsend3(1:2) .OR. lsend_bdyint(ib_bdy,3,1:2,ir)   ! west/east, V points
91               llrecv3(1:2) = llrecv3(1:2) .OR. lrecv_bdyint(ib_bdy,3,1:2,ir)   ! west/east, V points
92            CASE('neumann')
93               llsend2(:) = llsend2(:) .OR. lsend_bdyint(ib_bdy,2,:,ir)   ! possibly every direction, U points
94               llrecv2(:) = llrecv2(:) .OR. lrecv_bdyint(ib_bdy,2,:,ir)   ! possibly every direction, U points
95               llsend3(:) = llsend3(:) .OR. lsend_bdyint(ib_bdy,3,:,ir)   ! possibly every direction, V points
96               llrecv3(:) = llrecv3(:) .OR. lrecv_bdyint(ib_bdy,3,:,ir)   ! possibly every direction, V points
97            END SELECT
98         END DO
99         !
100         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction
[13247]101            CALL lbc_lnk( 'bdydyn2d', puu(:,:,:,Kaa), 'U', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )
[11536]102         END IF
103         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction
[13247]104            CALL lbc_lnk( 'bdydyn2d', pvv(:,:,:,Kaa), 'V', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )
[11536]105         END IF
106      END DO   ! ir
[6140]107      !
[3117]108   END SUBROUTINE bdy_dyn3d
109
[6140]110
[12377]111   SUBROUTINE bdy_dyn3d_spe( puu, pvv, Kaa, idx, dta, kt, ib_bdy )
[3651]112      !!----------------------------------------------------------------------
113      !!                  ***  SUBROUTINE bdy_dyn3d_spe  ***
114      !!
115      !! ** Purpose : - Apply a specified value for baroclinic velocities
116      !!                at open boundaries.
117      !!
118      !!----------------------------------------------------------------------
[12377]119      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
120      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
121      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
122      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
123      INTEGER                             , INTENT( in    ) ::   kt        ! Time step
124      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
[6140]125      !
[3651]126      INTEGER  ::   jb, jk         ! dummy loop indices
127      INTEGER  ::   ii, ij, igrd   ! local integers
128      !!----------------------------------------------------------------------
129      !
130      igrd = 2                      ! Relaxation of zonal velocity
131      DO jb = 1, idx%nblenrim(igrd)
132         DO jk = 1, jpkm1
133            ii   = idx%nbi(jb,igrd)
134            ij   = idx%nbj(jb,igrd)
[12377]135            puu(ii,ij,jk,Kaa) = dta%u3d(jb,jk) * umask(ii,ij,jk)
[3651]136         END DO
137      END DO
138      !
139      igrd = 3                      ! Relaxation of meridional velocity
140      DO jb = 1, idx%nblenrim(igrd)
141         DO jk = 1, jpkm1
142            ii   = idx%nbi(jb,igrd)
143            ij   = idx%nbj(jb,igrd)
[12377]144            pvv(ii,ij,jk,Kaa) = dta%v3d(jb,jk) * vmask(ii,ij,jk)
[3651]145         END DO
146      END DO
147      !
148   END SUBROUTINE bdy_dyn3d_spe
149
[9124]150
[12377]151   SUBROUTINE bdy_dyn3d_zgrad( puu, pvv, Kaa, idx, dta, kt, ib_bdy, llrim0 )
[7646]152      !!----------------------------------------------------------------------
153      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  ***
154      !!
155      !! ** Purpose : - Enforce a zero gradient of normal velocity
156      !!
157      !!----------------------------------------------------------------------
[12377]158      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
159      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
160      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
161      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
162      INTEGER                             , INTENT( in    ) ::   kt
163      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
164      LOGICAL                             , INTENT( in    ) ::   llrim0   ! indicate if rim 0 is treated
[7646]165      !!
166      INTEGER  ::   jb, jk         ! dummy loop indices
167      INTEGER  ::   ii, ij, igrd   ! local integers
[11536]168      INTEGER  ::   flagu, flagv           ! short cuts
169      INTEGER  ::   ibeg, iend     ! length of rim to be treated (rim 0 or rim 1 or both)
[7646]170      !!----------------------------------------------------------------------
171      !
172      igrd = 2                      ! Copying tangential velocity into bdy points
[11536]173      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)
174      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)
175      ENDIF
176      DO jb = ibeg, iend
177         ii    = idx%nbi(jb,igrd)
178         ij    = idx%nbj(jb,igrd)
179         flagu = NINT(idx%flagu(jb,igrd))
180         flagv = NINT(idx%flagv(jb,igrd))
181         !
182         IF( flagu == 0 )   THEN              ! north/south bdy
183            IF( ij+flagv > jpj .OR. ij+flagv < 1 )   CYCLE     
184            !
185            DO jk = 1, jpkm1
[12377]186               puu(ii,ij,jk,Kaa) = puu(ii,ij+flagv,jk,Kaa) * umask(ii,ij+flagv,jk)
[11536]187            END DO
188            !
189         END IF
[7646]190      END DO
191      !
192      igrd = 3                      ! Copying tangential velocity into bdy points
[11536]193      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)
194      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)
195      ENDIF
196      DO jb = ibeg, iend
197         ii    = idx%nbi(jb,igrd)
198         ij    = idx%nbj(jb,igrd)
199         flagu = NINT(idx%flagu(jb,igrd))
200         flagv = NINT(idx%flagv(jb,igrd))
201         !
202         IF( flagv == 0 )   THEN              !  west/east  bdy
203            IF( ii+flagu > jpi .OR. ii+flagu < 1 )   CYCLE     
204            !
205            DO jk = 1, jpkm1
[12377]206               pvv(ii,ij,jk,Kaa) = pvv(ii+flagu,ij,jk,Kaa) * vmask(ii+flagu,ij,jk)
[11536]207            END DO
208            !
209         END IF
[7646]210      END DO
211      !
[9124]212   END SUBROUTINE bdy_dyn3d_zgrad
[6140]213
[7646]214
[12377]215   SUBROUTINE bdy_dyn3d_zro( puu, pvv, Kaa, idx, dta, kt, ib_bdy )
[3651]216      !!----------------------------------------------------------------------
217      !!                  ***  SUBROUTINE bdy_dyn3d_zro  ***
218      !!
219      !! ** Purpose : - baroclinic velocities = 0. at open boundaries.
220      !!
221      !!----------------------------------------------------------------------
[12377]222      INTEGER                             , INTENT( in    ) ::   kt        ! time step index
223      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
224      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
225      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
226      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
227      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
[6140]228      !
[3651]229      INTEGER  ::   ib, ik         ! dummy loop indices
[6140]230      INTEGER  ::   ii, ij, igrd   ! local integers
[3651]231      !!----------------------------------------------------------------------
232      !
233      igrd = 2                       ! Everything is at T-points here
234      DO ib = 1, idx%nblenrim(igrd)
235         ii = idx%nbi(ib,igrd)
236         ij = idx%nbj(ib,igrd)
237         DO ik = 1, jpkm1
[12377]238            puu(ii,ij,ik,Kaa) = 0._wp
[3651]239         END DO
240      END DO
[11536]241      !
[3651]242      igrd = 3                       ! Everything is at T-points here
243      DO ib = 1, idx%nblenrim(igrd)
244         ii = idx%nbi(ib,igrd)
245         ij = idx%nbj(ib,igrd)
246         DO ik = 1, jpkm1
[12377]247            pvv(ii,ij,ik,Kaa) = 0._wp
[3651]248         END DO
249      END DO
250      !
[6140]251   END SUBROUTINE bdy_dyn3d_zro
[3651]252
253
[12377]254   SUBROUTINE bdy_dyn3d_frs( puu, pvv, Kaa, idx, dta, kt, ib_bdy )
[3117]255      !!----------------------------------------------------------------------
256      !!                  ***  SUBROUTINE bdy_dyn3d_frs  ***
257      !!
258      !! ** Purpose : - Apply the Flow Relaxation Scheme for baroclinic velocities
259      !!                at open boundaries.
260      !!
261      !! References :- Engedahl H., 1995: Use of the flow relaxation scheme in
262      !!               a three-dimensional baroclinic ocean model with realistic
263      !!               topography. Tellus, 365-382.
264      !!----------------------------------------------------------------------
[12377]265      INTEGER                             , INTENT( in    ) ::   kt        ! time step index
266      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
267      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
268      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
269      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
270      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
[6140]271      !
[3117]272      INTEGER  ::   jb, jk         ! dummy loop indices
273      INTEGER  ::   ii, ij, igrd   ! local integers
274      REAL(wp) ::   zwgt           ! boundary weight
275      !!----------------------------------------------------------------------
276      !
277      igrd = 2                      ! Relaxation of zonal velocity
278      DO jb = 1, idx%nblen(igrd)
279         DO jk = 1, jpkm1
280            ii   = idx%nbi(jb,igrd)
281            ij   = idx%nbj(jb,igrd)
282            zwgt = idx%nbw(jb,igrd)
[12377]283            puu(ii,ij,jk,Kaa) = ( puu(ii,ij,jk,Kaa) + zwgt * ( dta%u3d(jb,jk) - puu(ii,ij,jk,Kaa) ) ) * umask(ii,ij,jk)
[3117]284         END DO
285      END DO
286      !
287      igrd = 3                      ! Relaxation of meridional velocity
288      DO jb = 1, idx%nblen(igrd)
289         DO jk = 1, jpkm1
290            ii   = idx%nbi(jb,igrd)
291            ij   = idx%nbj(jb,igrd)
292            zwgt = idx%nbw(jb,igrd)
[12377]293            pvv(ii,ij,jk,Kaa) = ( pvv(ii,ij,jk,Kaa) + zwgt * ( dta%v3d(jb,jk) - pvv(ii,ij,jk,Kaa) ) ) * vmask(ii,ij,jk)
[3117]294         END DO
[11536]295      END DO   
[3117]296      !
[6140]297   END SUBROUTINE bdy_dyn3d_frs
[3117]298
[3182]299
[12377]300   SUBROUTINE bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx, dta, ib_bdy, llrim0, ll_npo )
[4292]301      !!----------------------------------------------------------------------
302      !!                 ***  SUBROUTINE bdy_dyn3d_orlanski  ***
303      !!             
304      !!              - Apply Orlanski radiation to baroclinic velocities.
305      !!              - Wrapper routine for bdy_orlanski_3d
306      !!
307      !!
308      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)   
309      !!----------------------------------------------------------------------
[12377]310      INTEGER                             , INTENT( in    ) ::   Kbb, Kaa  ! Time level indices
311      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
312      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
313      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
314      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
315      LOGICAL                             , INTENT( in    ) ::   llrim0    ! indicate if rim 0 is treated
316      LOGICAL                             , INTENT( in    ) ::   ll_npo    ! switch for NPO version
[4292]317
318      INTEGER  ::   jb, igrd                               ! dummy loop indices
319      !!----------------------------------------------------------------------
320      !
[12377]321      !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities.
[4292]322      !
323      igrd = 2      ! Orlanski bc on u-velocity;
324      !           
[12377]325      CALL bdy_orlanski_3d( idx, igrd, puu(:,:,:,Kbb), puu(:,:,:,Kaa), dta%u3d, ll_npo, llrim0 )
[4292]326
327      igrd = 3      ! Orlanski bc on v-velocity
328      ! 
[12377]329      CALL bdy_orlanski_3d( idx, igrd, pvv(:,:,:,Kbb), pvv(:,:,:,Kaa), dta%v3d, ll_npo, llrim0 )
[4292]330      !
331   END SUBROUTINE bdy_dyn3d_orlanski
332
333
[12377]334   SUBROUTINE bdy_dyn3d_dmp( kt, Kbb, puu, pvv, Krhs )
[3651]335      !!----------------------------------------------------------------------
336      !!                  ***  SUBROUTINE bdy_dyn3d_dmp  ***
337      !!
338      !! ** Purpose : Apply damping for baroclinic velocities at open boundaries.
339      !!
340      !!----------------------------------------------------------------------
[12377]341      INTEGER                             , INTENT( in    ) ::   kt        ! time step
342      INTEGER                             , INTENT( in    ) ::   Kbb, Krhs ! Time level indices
343      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities and trends (to be updated at open boundaries)
[6140]344      !
[3651]345      INTEGER  ::   jb, jk         ! dummy loop indices
[6140]346      INTEGER  ::   ib_bdy         ! loop index
[3651]347      INTEGER  ::   ii, ij, igrd   ! local integers
348      REAL(wp) ::   zwgt           ! boundary weight
349      !!----------------------------------------------------------------------
350      !
[9124]351      IF( ln_timing )   CALL timing_start('bdy_dyn3d_dmp')
[3651]352      !
353      DO ib_bdy=1, nb_bdy
[4292]354         IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN
[3651]355            igrd = 2                      ! Relaxation of zonal velocity
356            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)
357               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
358               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
359               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
360               DO jk = 1, jpkm1
[12377]361                  puu(ii,ij,jk,Krhs) = ( puu(ii,ij,jk,Krhs) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - &
362                                   puu(ii,ij,jk,Kbb) + uu_b(ii,ij,Kbb)) ) * umask(ii,ij,jk)
[3651]363               END DO
364            END DO
365            !
366            igrd = 3                      ! Relaxation of meridional velocity
367            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)
368               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
369               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
370               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
371               DO jk = 1, jpkm1
[12377]372                  pvv(ii,ij,jk,Krhs) = ( pvv(ii,ij,jk,Krhs) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  &
373                                   pvv(ii,ij,jk,Kbb) + vv_b(ii,ij,Kbb)) ) * vmask(ii,ij,jk)
[3651]374               END DO
375            END DO
376         ENDIF
[6140]377      END DO
[3651]378      !
[9124]379      IF( ln_timing )   CALL timing_stop('bdy_dyn3d_dmp')
[6140]380      !
[3651]381   END SUBROUTINE bdy_dyn3d_dmp
382
[9124]383
[12377]384   SUBROUTINE bdy_dyn3d_nmn( puu, pvv, Kaa, idx, ib_bdy, llrim0 )
[7646]385      !!----------------------------------------------------------------------
386      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  ***
387      !!             
388      !!              - Apply Neumann condition to baroclinic velocities.
389      !!              - Wrapper routine for bdy_nmn
390      !!
391      !!
392      !!----------------------------------------------------------------------
[12377]393      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
394      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
395      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
396      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
397      LOGICAL                             , INTENT( in    ) ::   llrim0    ! indicate if rim 0 is treated
[11536]398      INTEGER  ::   igrd                        ! dummy indice
[7646]399      !!----------------------------------------------------------------------
400      !
[12377]401      !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities.
[7646]402      !
403      igrd = 2      ! Neumann bc on u-velocity;
404      !           
[12377]405      CALL bdy_nmn( idx, igrd, puu(:,:,:,Kaa), llrim0 )
[7646]406
407      igrd = 3      ! Neumann bc on v-velocity
408      ! 
[12377]409      CALL bdy_nmn( idx, igrd, pvv(:,:,:,Kaa), llrim0 )
[7646]410      !
411   END SUBROUTINE bdy_dyn3d_nmn
412
[3117]413   !!======================================================================
414END MODULE bdydyn3d
Note: See TracBrowser for help on using the repository browser.