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/2014/dev_r4743_NOC2_ZTS/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/2014/dev_r4743_NOC2_ZTS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 4891

Last change on this file since 4891 was 4891, checked in by acc, 10 years ago

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