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

source: branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 6010

Last change on this file since 6010 was 6006, checked in by mathiot, 8 years ago

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