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.
lbclnk.F90 in branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 6060

Last change on this file since 6060 was 6060, checked in by timgraham, 8 years ago

Merged dev_r5836_noc2_VVL_BY_DEFAULT into branch
  • Property svn:keywords set to Id
File size: 21.0 KB
Line 
1MODULE lbclnk
2   !!======================================================================
3   !!                       ***  MODULE  lbclnk  ***
4   !! Ocean        : lateral boundary conditions
5   !!=====================================================================
6   !! History :  OPA  ! 1997-06  (G. Madec)  Original code
7   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
8   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment 
9   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
10   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case 
11   !!----------------------------------------------------------------------
12#if defined key_mpp_mpi
13   !!----------------------------------------------------------------------
14   !!   'key_mpp_mpi'             MPI massively parallel processing library
15   !!----------------------------------------------------------------------
16   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
17   !!   lbc_lnk_e     : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
18   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
19   !!----------------------------------------------------------------------
20   USE lib_mpp        ! distributed memory computing library
21
22   INTERFACE lbc_lnk_multi
23      MODULE PROCEDURE mpp_lnk_2d_9
24   END INTERFACE
25   !
26   INTERFACE lbc_lnk
27      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
28   END INTERFACE
29   !
30   INTERFACE lbc_bdy_lnk
31      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
32   END INTERFACE
33   !
34   INTERFACE lbc_lnk_e
35      MODULE PROCEDURE mpp_lnk_2d_e
36   END INTERFACE
37   !
38   INTERFACE lbc_lnk_icb
39      MODULE PROCEDURE mpp_lnk_2d_icb
40   END INTERFACE
41
42   PUBLIC   lbc_lnk       ! ocean lateral boundary conditions
43   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
44   PUBLIC   lbc_lnk_e     !
45   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
46   PUBLIC   lbc_lnk_icb   !
47
48   !!----------------------------------------------------------------------
49   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
50   !! $Id$
51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
52   !!----------------------------------------------------------------------
53#else
54   !!----------------------------------------------------------------------
55   !!   Default option                              shared memory computing
56   !!----------------------------------------------------------------------
57   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
58   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
59   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
60   !!   lbc_bdy_lnk  : set the lateral BDY boundary condition
61   !!----------------------------------------------------------------------
62   USE oce             ! ocean dynamics and tracers   
63   USE dom_oce         ! ocean space and time domain
64   USE in_out_manager  ! I/O manager
65   USE lbcnfd          ! north fold
66
67   IMPLICIT NONE
68   PRIVATE
69
70   INTERFACE lbc_lnk
71      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
72   END INTERFACE
73   !
74   INTERFACE lbc_lnk_e
75      MODULE PROCEDURE lbc_lnk_2d_e
76   END INTERFACE
77   !
78   INTERFACE lbc_bdy_lnk
79      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
80   END INTERFACE
81   !
82   INTERFACE lbc_lnk_icb
83      MODULE PROCEDURE lbc_lnk_2d_e
84   END INTERFACE
85
86   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
87   PUBLIC   lbc_lnk_e     !
88   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
89   PUBLIC   lbc_lnk_icb   !
90   
91   !!----------------------------------------------------------------------
92   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
93   !! $Id$
94   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
95   !!----------------------------------------------------------------------
96CONTAINS
97
98# if defined key_c1d
99   !!----------------------------------------------------------------------
100   !!   'key_c1d'                                          1D configuration
101   !!----------------------------------------------------------------------
102
103   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
104      !!---------------------------------------------------------------------
105      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
106      !!
107      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case)
108      !!
109      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2
110      !!----------------------------------------------------------------------
111      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
112      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
113      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign
114      !!----------------------------------------------------------------------
115      !
116      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
117      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
118      !
119   END SUBROUTINE lbc_lnk_3d_gather
120
121
122   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
123      !!---------------------------------------------------------------------
124      !!                  ***  ROUTINE lbc_lnk_3d  ***
125      !!
126      !! ** Purpose :   set lateral boundary conditions on a 3D array (C1D case)
127      !!
128      !! ** Method  :   1D case, the central water column is set everywhere
129      !!----------------------------------------------------------------------
130      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
131      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
132      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
133      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
134      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
135      !
136      INTEGER  ::   jk     ! dummy loop index
137      REAL(wp) ::   ztab   ! local scalar
138      !!----------------------------------------------------------------------
139      !
140      DO jk = 1, jpk
141         ztab = pt3d(2,2,jk)
142         pt3d(:,:,jk) = ztab
143      END DO
144      !
145   END SUBROUTINE lbc_lnk_3d
146
147
148   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
149      !!---------------------------------------------------------------------
150      !!                 ***  ROUTINE lbc_lnk_2d  ***
151      !!
152      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
153      !!
154      !! ** Method  :   1D case, the central water column is set everywhere
155      !!----------------------------------------------------------------------
156      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
157      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
158      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
159      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
160      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
161      !
162      REAL(wp) ::   ztab   ! local scalar
163      !!----------------------------------------------------------------------
164      !
165      ztab = pt2d(2,2)
166      pt2d(:,:) = ztab
167      !
168   END SUBROUTINE lbc_lnk_2d
169
170#else
171   !!----------------------------------------------------------------------
172   !!   Default option                           3D shared memory computing
173   !!----------------------------------------------------------------------
174
175   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
176      !!---------------------------------------------------------------------
177      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
178      !!
179      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
180      !!
181      !! ** Method  :   psign = -1 :    change the sign across the north fold
182      !!                      =  1 : no change of the sign across the north fold
183      !!                      =  0 : no change of the sign across the north fold and
184      !!                             strict positivity preserved: use inner row/column
185      !!                             for closed boundaries.
186      !!----------------------------------------------------------------------
187      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
188      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
189      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign
190      !!----------------------------------------------------------------------
191      !
192      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
193      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
194      !
195   END SUBROUTINE lbc_lnk_3d_gather
196
197
198   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
199      !!---------------------------------------------------------------------
200      !!                  ***  ROUTINE lbc_lnk_3d  ***
201      !!
202      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
203      !!
204      !! ** Method  :   psign = -1 :    change the sign across the north fold
205      !!                      =  1 : no change of the sign across the north fold
206      !!                      =  0 : no change of the sign across the north fold and
207      !!                             strict positivity preserved: use inner row/column
208      !!                             for closed boundaries.
209      !!----------------------------------------------------------------------
210      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
211      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
212      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
213      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
214      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
215      !!
216      REAL(wp) ::   zland
217      !!----------------------------------------------------------------------
218
219      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
220      ELSE                         ;   zland = 0._wp
221      ENDIF
222
223
224      IF( PRESENT( cd_mpp ) ) THEN
225         ! only fill the overlap area and extra allows
226         ! this is in mpp case. In this module, just do nothing
227      ELSE
228         !                                     !  East-West boundaries
229         !                                     ! ======================
230         SELECT CASE ( nperio )
231         !
232         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
233            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
234            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
235            !
236         CASE DEFAULT                             !**  East closed  --  West closed
237            SELECT CASE ( cd_type )
238            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
239               pt3d( 1 ,:,:) = zland
240               pt3d(jpi,:,:) = zland
241            CASE ( 'F' )                               ! F-point
242               pt3d(jpi,:,:) = zland
243            END SELECT
244            !
245         END SELECT
246         !                                     ! North-South boundaries
247         !                                     ! ======================
248         SELECT CASE ( nperio )
249         !
250         CASE ( 2 )                               !**  South symmetric  --  North closed
251            SELECT CASE ( cd_type )
252            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
253               pt3d(:, 1 ,:) = pt3d(:,3,:)
254               pt3d(:,jpj,:) = zland
255            CASE ( 'V' , 'F' )                         ! V-, F-points
256               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
257               pt3d(:,jpj,:) = zland
258            END SELECT
259            !
260         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
261            SELECT CASE ( cd_type )                    ! South : closed
262            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
263               pt3d(:, 1 ,:) = zland
264            END SELECT
265            !                                          ! North fold
266            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
267            !
268         CASE DEFAULT                             !**  North closed  --  South closed
269            SELECT CASE ( cd_type )
270            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
271               pt3d(:, 1 ,:) = zland
272               pt3d(:,jpj,:) = zland
273            CASE ( 'F' )                               ! F-point
274               pt3d(:,jpj,:) = zland
275            END SELECT
276            !
277         END SELECT
278         !
279      ENDIF
280      !
281   END SUBROUTINE lbc_lnk_3d
282
283
284   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
285      !!---------------------------------------------------------------------
286      !!                 ***  ROUTINE lbc_lnk_2d  ***
287      !!
288      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
289      !!
290      !! ** Method  :   psign = -1 :    change the sign across the north fold
291      !!                      =  1 : no change of the sign across the north fold
292      !!                      =  0 : no change of the sign across the north fold and
293      !!                             strict positivity preserved: use inner row/column
294      !!                             for closed boundaries.
295      !!----------------------------------------------------------------------
296      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
297      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
298      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
299      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
300      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
301      !!
302      REAL(wp) ::   zland
303      !!----------------------------------------------------------------------
304
305      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
306      ELSE                         ;   zland = 0._wp
307      ENDIF
308
309      IF (PRESENT(cd_mpp)) THEN
310         ! only fill the overlap area and extra allows
311         ! this is in mpp case. In this module, just do nothing
312      ELSE     
313         !                                     ! East-West boundaries
314         !                                     ! ====================
315         SELECT CASE ( nperio )
316         !
317         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
318            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
319            pt2d(jpi,:) = pt2d(  2  ,:)
320            !
321         CASE DEFAULT                             !** East closed  --  West closed
322            SELECT CASE ( cd_type )
323            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
324               pt2d( 1 ,:) = zland
325               pt2d(jpi,:) = zland
326            CASE ( 'F' )                              ! F-point
327               pt2d(jpi,:) = zland
328            END SELECT
329            !
330         END SELECT
331         !                                     ! North-South boundaries
332         !                                     ! ======================
333         SELECT CASE ( nperio )
334         !
335         CASE ( 2 )                               !**  South symmetric  --  North closed
336            SELECT CASE ( cd_type )
337            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
338               pt2d(:, 1 ) = pt2d(:,3)
339               pt2d(:,jpj) = zland
340            CASE ( 'V' , 'F' )                         ! V-, F-points
341               pt2d(:, 1 ) = psgn * pt2d(:,2)
342               pt2d(:,jpj) = zland
343            END SELECT
344            !
345         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
346            SELECT CASE ( cd_type )                    ! South : closed
347            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
348               pt2d(:, 1 ) = zland
349            END SELECT
350            !                                          ! North fold
351            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
352            !
353         CASE DEFAULT                             !**  North closed  --  South closed
354            SELECT CASE ( cd_type )
355            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
356               pt2d(:, 1 ) = zland
357               pt2d(:,jpj) = zland
358            CASE ( 'F' )                               ! F-point
359               pt2d(:,jpj) = zland
360            END SELECT
361            !
362         END SELECT
363         !
364      ENDIF
365      !   
366   END SUBROUTINE lbc_lnk_2d
367
368#endif
369
370   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
371      !!---------------------------------------------------------------------
372      !!                  ***  ROUTINE lbc_bdy_lnk  ***
373      !!
374      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
375      !!              to maintain the same interface with regards to the mpp case
376      !!
377      !!----------------------------------------------------------------------
378      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
379      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
380      REAL(wp)                        , INTENT(in   ) ::   psgn      ! control of the sign
381      INTEGER                         , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
382      !!----------------------------------------------------------------------
383      !
384      CALL lbc_lnk_3d( pt3d, cd_type, psgn)
385      !
386   END SUBROUTINE lbc_bdy_lnk_3d
387
388
389   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
390      !!---------------------------------------------------------------------
391      !!                  ***  ROUTINE lbc_bdy_lnk  ***
392      !!
393      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
394      !!              to maintain the same interface with regards to the mpp case
395      !!
396      !!----------------------------------------------------------------------
397      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
398      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
399      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign
400      INTEGER                     , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
401      !!----------------------------------------------------------------------
402      !
403      CALL lbc_lnk_2d( pt2d, cd_type, psgn)
404      !
405   END SUBROUTINE lbc_bdy_lnk_2d
406
407
408   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
409      !!---------------------------------------------------------------------
410      !!                 ***  ROUTINE lbc_lnk_2d  ***
411      !!
412      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
413      !!                special dummy routine to allow for use of halo indexing in mpp case
414      !!
415      !! ** Method  :   psign = -1 :    change the sign across the north fold
416      !!                      =  1 : no change of the sign across the north fold
417      !!                      =  0 : no change of the sign across the north fold and
418      !!                             strict positivity preserved: use inner row/column
419      !!                             for closed boundaries.
420      !!----------------------------------------------------------------------
421      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
422      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
423      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign
424      INTEGER                     , INTENT(in   ) ::   jpri      ! size of extra halo (not needed in non-mpp)
425      INTEGER                     , INTENT(in   ) ::   jprj      ! size of extra halo (not needed in non-mpp)
426      !!----------------------------------------------------------------------
427      !
428      CALL lbc_lnk_2d( pt2d, cd_type, psgn )
429      !   
430   END SUBROUTINE lbc_lnk_2d_e
431
432#endif
433
434   !!======================================================================
435END MODULE lbclnk
Note: See TracBrowser for help on using the repository browser.