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/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY – NEMO

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

Last change on this file since 11071 was 11071, checked in by girrmann, 5 years ago

dev_r10984_HPC-13 : step 2, remove unneeded communications, see #2285
  • Property svn:keywords set to Id
File size: 16.4 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) :: llsend2, llrecv2, llsend3, llrecv3  ! 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      llsend2(:) = .false.
64      llrecv2(:) = .false.
65      llsend3(:) = .false.
66      llrecv3(:) = .false.
67      DO ib_bdy=1, nb_bdy
68         SELECT CASE( cn_dyn3d(ib_bdy) )
69         CASE('orlanski', 'orlanski_npo')
70            llsend2(:) = llsend2(:) .OR. lsend_bdy(ib_bdy,2,:)   ! possibly every direction, U points
71            llrecv2(:) = llrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:)   ! possibly every direction, U points
72            llsend3(:) = llsend3(:) .OR. lsend_bdy(ib_bdy,3,:)   ! possibly every direction, V points
73            llrecv3(:) = llrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:)   ! possibly every direction, V points
74         CASE('zerograd')
75            llsend2(3:4) = llsend2(3:4) .OR. lsend_bdyint(ib_bdy,2,3:4)   ! north/south, U points
76            llrecv2(3:4) = llrecv2(3:4) .OR. lrecv_bdyint(ib_bdy,2,3:4)   ! north/south, U points
77            llsend3(1:2) = llsend3(1:2) .OR. lsend_bdyint(ib_bdy,3,1:2)   ! west/east, V points
78            llrecv3(1:2) = llrecv3(1:2) .OR. lrecv_bdyint(ib_bdy,3,1:2)   ! west/east, V points
79         CASE('neumann')
80            llsend2(:) = llsend2(:) .OR. lsend_bdyint(ib_bdy,2,:)   ! possibly every direction, U points
81            llrecv2(:) = llrecv2(:) .OR. lrecv_bdyint(ib_bdy,2,:)   ! possibly every direction, U points
82            llsend3(:) = llsend3(:) .OR. lsend_bdyint(ib_bdy,3,:)   ! possibly every direction, V points
83            llrecv3(:) = llrecv3(:) .OR. lrecv_bdyint(ib_bdy,3,:)   ! possibly every direction, V points
84         END SELECT
85      END DO
86      !
87      IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction
88         CALL lbc_bdy_lnk( 'bdydyn2d', llsend2, llrecv2, ua, 'U', -1. )
89      END IF
90      IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction
91         CALL lbc_bdy_lnk( 'bdydyn2d', llsend3, llrecv3, va, 'V', -1. )
92      END IF
93      !
94   END SUBROUTINE bdy_dyn3d
95
96
97   SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy )
98      !!----------------------------------------------------------------------
99      !!                  ***  SUBROUTINE bdy_dyn3d_spe  ***
100      !!
101      !! ** Purpose : - Apply a specified value for baroclinic velocities
102      !!                at open boundaries.
103      !!
104      !!----------------------------------------------------------------------
105      INTEGER        , INTENT(in) ::   kt      ! time step index
106      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
107      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
108      INTEGER        , INTENT(in) ::   ib_bdy  ! BDY set index
109      !
110      INTEGER  ::   jb, jk         ! dummy loop indices
111      INTEGER  ::   ii, ij, igrd   ! local integers
112      !!----------------------------------------------------------------------
113      !
114      igrd = 2                      ! Relaxation of zonal velocity
115      DO jb = 1, idx%nblenrim(igrd)
116         DO jk = 1, jpkm1
117            ii   = idx%nbi(jb,igrd)
118            ij   = idx%nbj(jb,igrd)
119            ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk)
120         END DO
121      END DO
122      !
123      igrd = 3                      ! Relaxation of meridional velocity
124      DO jb = 1, idx%nblenrim(igrd)
125         DO jk = 1, jpkm1
126            ii   = idx%nbi(jb,igrd)
127            ij   = idx%nbj(jb,igrd)
128            va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk)
129         END DO
130      END DO
131      !
132   END SUBROUTINE bdy_dyn3d_spe
133
134
135   SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy )
136      !!----------------------------------------------------------------------
137      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  ***
138      !!
139      !! ** Purpose : - Enforce a zero gradient of normal velocity
140      !!
141      !!----------------------------------------------------------------------
142      INTEGER                     ::   kt
143      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
144      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
145      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
146      !!
147      INTEGER  ::   jb, jk         ! dummy loop indices
148      INTEGER  ::   ii, ij, igrd   ! local integers
149      INTEGER  ::   flagu, flagv           ! short cuts
150      !!----------------------------------------------------------------------
151      !
152      igrd = 2                      ! Copying tangential velocity into bdy points
153      DO jb = 1, idx%nblenrim(igrd)
154         ii    = idx%nbi(jb,igrd)
155         ij    = idx%nbj(jb,igrd)
156         flagu = NINT(idx%flagu(jb,igrd))
157         flagv = NINT(idx%flagv(jb,igrd))
158         !
159         IF( flagu == 0 )   THEN              ! north/south bdy
160            IF( ij+flagv > jpj .OR. ij+flagv < 1 )   CYCLE     
161            !
162            DO jk = 1, jpkm1
163               ua(ii,ij,jk) = ua(ii,ij+flagv,jk) * umask(ii,ij+flagv,jk)
164            END DO
165            !
166         END IF
167      END DO
168      !
169      igrd = 3                      ! Copying tangential velocity into bdy points
170      DO jb = 1, idx%nblenrim(igrd)
171         ii    = idx%nbi(jb,igrd)
172         ij    = idx%nbj(jb,igrd)
173         flagu = NINT(idx%flagu(jb,igrd))
174         flagv = NINT(idx%flagv(jb,igrd))
175         !
176         IF( flagv == 0 )   THEN              !  west/east  bdy
177            IF( ii+flagu > jpi .OR. ii+flagu < 1 )   CYCLE     
178            !
179            DO jk = 1, jpkm1
180               va(ii,ij,jk) = va(ii+flagu,ij,jk) * vmask(ii+flagu,ij,jk)
181            END DO
182            !
183         END IF
184      END DO
185      !
186   END SUBROUTINE bdy_dyn3d_zgrad
187
188
189   SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy )
190      !!----------------------------------------------------------------------
191      !!                  ***  SUBROUTINE bdy_dyn3d_zro  ***
192      !!
193      !! ** Purpose : - baroclinic velocities = 0. at open boundaries.
194      !!
195      !!----------------------------------------------------------------------
196      INTEGER        , INTENT(in) ::   kt      ! time step index
197      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
198      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
199      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
200      !
201      INTEGER  ::   ib, ik         ! dummy loop indices
202      INTEGER  ::   ii, ij, igrd   ! local integers
203      !!----------------------------------------------------------------------
204      !
205      igrd = 2                       ! Everything is at T-points here
206      DO ib = 1, idx%nblenrim(igrd)
207         ii = idx%nbi(ib,igrd)
208         ij = idx%nbj(ib,igrd)
209         DO ik = 1, jpkm1
210            ua(ii,ij,ik) = 0._wp
211         END DO
212      END DO
213      !
214      igrd = 3                       ! Everything is at T-points here
215      DO ib = 1, idx%nblenrim(igrd)
216         ii = idx%nbi(ib,igrd)
217         ij = idx%nbj(ib,igrd)
218         DO ik = 1, jpkm1
219            va(ii,ij,ik) = 0._wp
220         END DO
221      END DO
222      !
223   END SUBROUTINE bdy_dyn3d_zro
224
225
226   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy )
227      !!----------------------------------------------------------------------
228      !!                  ***  SUBROUTINE bdy_dyn3d_frs  ***
229      !!
230      !! ** Purpose : - Apply the Flow Relaxation Scheme for baroclinic velocities
231      !!                at open boundaries.
232      !!
233      !! References :- Engedahl H., 1995: Use of the flow relaxation scheme in
234      !!               a three-dimensional baroclinic ocean model with realistic
235      !!               topography. Tellus, 365-382.
236      !!----------------------------------------------------------------------
237      INTEGER        , INTENT(in) ::   kt      ! time step index
238      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
239      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
240      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
241      !
242      INTEGER  ::   jb, jk         ! dummy loop indices
243      INTEGER  ::   ii, ij, igrd   ! local integers
244      REAL(wp) ::   zwgt           ! boundary weight
245      !!----------------------------------------------------------------------
246      !
247      igrd = 2                      ! Relaxation of zonal velocity
248      DO jb = 1, idx%nblen(igrd)
249         DO jk = 1, jpkm1
250            ii   = idx%nbi(jb,igrd)
251            ij   = idx%nbj(jb,igrd)
252            zwgt = idx%nbw(jb,igrd)
253            ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta%u3d(jb,jk) - ua(ii,ij,jk) ) ) * umask(ii,ij,jk)
254         END DO
255      END DO
256      !
257      igrd = 3                      ! Relaxation of meridional velocity
258      DO jb = 1, idx%nblen(igrd)
259         DO jk = 1, jpkm1
260            ii   = idx%nbi(jb,igrd)
261            ij   = idx%nbj(jb,igrd)
262            zwgt = idx%nbw(jb,igrd)
263            va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk)
264         END DO
265      END DO   
266      !
267   END SUBROUTINE bdy_dyn3d_frs
268
269
270   SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo )
271      !!----------------------------------------------------------------------
272      !!                 ***  SUBROUTINE bdy_dyn3d_orlanski  ***
273      !!             
274      !!              - Apply Orlanski radiation to baroclinic velocities.
275      !!              - Wrapper routine for bdy_orlanski_3d
276      !!
277      !!
278      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)   
279      !!----------------------------------------------------------------------
280      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
281      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
282      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index
283      LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version
284
285      INTEGER  ::   jb, igrd                               ! dummy loop indices
286      !!----------------------------------------------------------------------
287      !
288      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.
289      !
290      igrd = 2      ! Orlanski bc on u-velocity;
291      !           
292      CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo )
293
294      igrd = 3      ! Orlanski bc on v-velocity
295      ! 
296      CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo )
297      !
298   END SUBROUTINE bdy_dyn3d_orlanski
299
300
301   SUBROUTINE bdy_dyn3d_dmp( kt )
302      !!----------------------------------------------------------------------
303      !!                  ***  SUBROUTINE bdy_dyn3d_dmp  ***
304      !!
305      !! ** Purpose : Apply damping for baroclinic velocities at open boundaries.
306      !!
307      !!----------------------------------------------------------------------
308      INTEGER, INTENT(in) ::   kt   ! time step index
309      !
310      INTEGER  ::   jb, jk         ! dummy loop indices
311      INTEGER  ::   ib_bdy         ! loop index
312      INTEGER  ::   ii, ij, igrd   ! local integers
313      REAL(wp) ::   zwgt           ! boundary weight
314      !!----------------------------------------------------------------------
315      !
316      IF( ln_timing )   CALL timing_start('bdy_dyn3d_dmp')
317      !
318      DO ib_bdy=1, nb_bdy
319         IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN
320            igrd = 2                      ! Relaxation of zonal velocity
321            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)
322               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
323               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
324               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
325               DO jk = 1, jpkm1
326                  ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - &
327                                   ub(ii,ij,jk) + ub_b(ii,ij)) ) * umask(ii,ij,jk)
328               END DO
329            END DO
330            !
331            igrd = 3                      ! Relaxation of meridional velocity
332            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)
333               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
334               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
335               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
336               DO jk = 1, jpkm1
337                  va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  &
338                                   vb(ii,ij,jk) + vb_b(ii,ij)) ) * vmask(ii,ij,jk)
339               END DO
340            END DO
341         ENDIF
342      END DO
343      !
344      IF( ln_timing )   CALL timing_stop('bdy_dyn3d_dmp')
345      !
346   END SUBROUTINE bdy_dyn3d_dmp
347
348
349   SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy )
350      !!----------------------------------------------------------------------
351      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  ***
352      !!             
353      !!              - Apply Neumann condition to baroclinic velocities.
354      !!              - Wrapper routine for bdy_nmn
355      !!
356      !!
357      !!----------------------------------------------------------------------
358      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
359      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index
360      INTEGER  ::   igrd                                    ! dummy indice
361      !!----------------------------------------------------------------------
362      !
363      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.
364      !
365      igrd = 2      ! Neumann bc on u-velocity;
366      !           
367      CALL bdy_nmn( idx, igrd, ua )   ! ua is masked
368
369      igrd = 3      ! Neumann bc on v-velocity
370      ! 
371      CALL bdy_nmn( idx, igrd, va )   ! va is masked
372      !
373   END SUBROUTINE bdy_dyn3d_nmn
374
375   !!======================================================================
376END MODULE bdydyn3d
Note: See TracBrowser for help on using the repository browser.