source: NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90 @ 11067

Last change on this file since 11067 was 11067, checked in by girrmann, 2 years ago

dev_r10984_HPC-13 : new implementation of lbc_bdy_lnk in prevision of step 2, regroup communications, see #2285

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