source: branches/2015/dev_r5546_CNRS19_HPC_scalability/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 5579

Last change on this file since 5579 was 5579, checked in by mcastril, 5 years ago

ticket #1539 Performance optimizations on NEMO 3.6 limhdf routine

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