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

source: branches/2015/dev_r5302_CNRS18_HPC_scalability/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 5372

Last change on this file since 5372 was 5372, checked in by mcastril, 9 years ago

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