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

source: branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 3680

Last change on this file since 3680 was 3680, checked in by rblod, 11 years ago

First commit of the final branch for 2012 (future nemo_3_5), see ticket #1028
  • Property svn:keywords set to Id
File size: 17.3 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   !!----------------------------------------------------------------------
13#if   defined key_mpp_mpi
14   !!----------------------------------------------------------------------
15   !!   'key_mpp_mpi'             MPI massively parallel processing library
16   !!----------------------------------------------------------------------
17   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
18   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
19   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
20   !!   lbc_obc_lnk  : generic interface for mpp_lnk_obc_2d and mpp_lnk_obc_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   INTERFACE lbc_obc_lnk
32      MODULE PROCEDURE mpp_lnk_obc_2d, mpp_lnk_obc_3d
33   END INTERFACE
34
35   INTERFACE lbc_lnk_e
36      MODULE PROCEDURE mpp_lnk_2d_e
37   END INTERFACE
38
39   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
40   PUBLIC lbc_lnk_e
41   PUBLIC lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
42   PUBLIC lbc_obc_lnk   ! ocean lateral BDY boundary conditions
43
44   !!----------------------------------------------------------------------
45   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
46   !! $Id$
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49
50#else
51   !!----------------------------------------------------------------------
52   !!   Default option                              shared memory computing
53   !!----------------------------------------------------------------------
54   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
55   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
56   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
57   !!   lbc_bdy_lnk  : set the lateral BDY boundary condition
58   !!   lbc_obc_lnk  : set the lateral OBC 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   INTERFACE lbc_obc_lnk
80      MODULE PROCEDURE lbc_lnk_2d, lbc_lnk_3d
81   END INTERFACE
82
83   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
84   PUBLIC   lbc_lnk_e 
85   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
86   PUBLIC   lbc_obc_lnk   ! ocean lateral OBC boundary conditions
87   
88   !!----------------------------------------------------------------------
89   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
90   !! $Id$
91   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
92   !!----------------------------------------------------------------------
93CONTAINS
94
95   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
96      !!---------------------------------------------------------------------
97      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
98      !!
99      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
100      !!
101      !! ** Method  :   psign = -1 :    change the sign across the north fold
102      !!                      =  1 : no change of the sign across the north fold
103      !!                      =  0 : no change of the sign across the north fold and
104      !!                             strict positivity preserved: use inner row/column
105      !!                             for closed boundaries.
106      !!----------------------------------------------------------------------
107      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
108      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
109      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign
110      !!----------------------------------------------------------------------
111      !
112      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
113      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
114      !
115   END SUBROUTINE lbc_lnk_3d_gather
116
117
118   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
119      !!---------------------------------------------------------------------
120      !!                  ***  ROUTINE lbc_lnk_3d  ***
121      !!
122      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
123      !!
124      !! ** Method  :   psign = -1 :    change the sign across the north fold
125      !!                      =  1 : no change of the sign across the north fold
126      !!                      =  0 : no change of the sign across the north fold and
127      !!                             strict positivity preserved: use inner row/column
128      !!                             for closed boundaries.
129      !!----------------------------------------------------------------------
130      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
131      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
132      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
133      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
134      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
135      !!
136      REAL(wp) ::   zland
137      !!----------------------------------------------------------------------
138
139      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
140      ELSE                         ;   zland = 0.e0
141      ENDIF
142
143
144      IF( PRESENT( cd_mpp ) ) THEN
145         ! only fill the overlap area and extra allows
146         ! this is in mpp case. In this module, just do nothing
147      ELSE
148         !
149         !                                     !  East-West boundaries
150         !                                     ! ======================
151         SELECT CASE ( nperio )
152         !
153         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
154            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
155            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
156            !
157         CASE DEFAULT                             !**  East closed  --  West closed
158            SELECT CASE ( cd_type )
159            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
160               pt3d( 1 ,:,:) = zland
161               pt3d(jpi,:,:) = zland
162            CASE ( 'F' )                               ! F-point
163               pt3d(jpi,:,:) = zland
164            END SELECT
165            !
166         END SELECT
167         !
168         !                                     ! North-South boundaries
169         !                                     ! ======================
170         SELECT CASE ( nperio )
171         !
172         CASE ( 2 )                               !**  South symmetric  --  North closed
173            SELECT CASE ( cd_type )
174            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
175               pt3d(:, 1 ,:) = pt3d(:,3,:)
176               pt3d(:,jpj,:) = zland
177            CASE ( 'V' , 'F' )                         ! V-, F-points
178               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
179               pt3d(:,jpj,:) = zland
180            END SELECT
181            !
182         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
183            SELECT CASE ( cd_type )                    ! South : closed
184            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
185               pt3d(:, 1 ,:) = zland
186            END SELECT
187            !                                          ! North fold
188            pt3d( 1 ,jpj,:) = zland
189            pt3d(jpi,jpj,:) = zland
190            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
191            !
192         CASE DEFAULT                             !**  North closed  --  South closed
193            SELECT CASE ( cd_type )
194            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
195               pt3d(:, 1 ,:) = zland
196               pt3d(:,jpj,:) = zland
197            CASE ( 'F' )                               ! F-point
198               pt3d(:,jpj,:) = zland
199            END SELECT
200            !
201         END SELECT
202         !
203      ENDIF
204      !
205   END SUBROUTINE lbc_lnk_3d
206
207   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
208      !!---------------------------------------------------------------------
209      !!                  ***  ROUTINE lbc_bdy_lnk  ***
210      !!
211      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
212      !!                to maintain the same interface with regards to the mpp case
213      !!
214      !!----------------------------------------------------------------------
215      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
216      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
217      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
218      INTEGER                                                   ::   ib_bdy    ! BDY boundary set
219      !!
220      CALL lbc_lnk_3d( pt3d, cd_type, psgn)
221
222   END SUBROUTINE lbc_bdy_lnk_3d
223
224   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
225      !!---------------------------------------------------------------------
226      !!                  ***  ROUTINE lbc_bdy_lnk  ***
227      !!
228      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
229      !!                to maintain the same interface with regards to the mpp case
230      !!
231      !!----------------------------------------------------------------------
232      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
233      REAL(wp), DIMENSION(jpi,jpj),     INTENT(inout)           ::   pt2d      ! 3D array on which the lbc is applied
234      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
235      INTEGER                                                   ::   ib_bdy    ! BDY boundary set
236      !!
237      CALL lbc_lnk_2d( pt2d, cd_type, psgn)
238
239   END SUBROUTINE lbc_bdy_lnk_2d
240
241   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
242      !!---------------------------------------------------------------------
243      !!                 ***  ROUTINE lbc_lnk_2d  ***
244      !!
245      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
246      !!
247      !! ** Method  :   psign = -1 :    change the sign across the north fold
248      !!                      =  1 : no change of the sign across the north fold
249      !!                      =  0 : no change of the sign across the north fold and
250      !!                             strict positivity preserved: use inner row/column
251      !!                             for closed boundaries.
252      !!----------------------------------------------------------------------
253      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
254      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
255      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
256      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
257      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
258      !!
259      REAL(wp) ::   zland
260      !!----------------------------------------------------------------------
261
262      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
263      ELSE                         ;   zland = 0.e0
264      ENDIF
265
266      IF (PRESENT(cd_mpp)) THEN
267         ! only fill the overlap area and extra allows
268         ! this is in mpp case. In this module, just do nothing
269      ELSE     
270         !
271         !                                     ! East-West boundaries
272         !                                     ! ====================
273         SELECT CASE ( nperio )
274         !
275         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
276            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
277            pt2d(jpi,:) = pt2d(  2  ,:)
278            !
279         CASE DEFAULT                             !** East closed  --  West closed
280            SELECT CASE ( cd_type )
281            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
282               pt2d( 1 ,:) = zland
283               pt2d(jpi,:) = zland
284            CASE ( 'F' )                              ! F-point
285               pt2d(jpi,:) = zland
286            END SELECT
287            !
288         END SELECT
289         !
290         !                                     ! North-South boundaries
291         !                                     ! ======================
292         SELECT CASE ( nperio )
293         !
294         CASE ( 2 )                               !**  South symmetric  --  North closed
295            SELECT CASE ( cd_type )
296            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
297               pt2d(:, 1 ) = pt2d(:,3)
298               pt2d(:,jpj) = zland
299            CASE ( 'V' , 'F' )                         ! V-, F-points
300               pt2d(:, 1 ) = psgn * pt2d(:,2)
301               pt2d(:,jpj) = zland
302            END SELECT
303            !
304         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
305            SELECT CASE ( cd_type )                    ! South : closed
306            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
307               pt2d(:, 1 ) = zland
308            END SELECT
309            !                                          ! North fold
310            pt2d( 1 ,1  ) = zland 
311            pt2d( 1 ,jpj) = zland 
312            pt2d(jpi,jpj) = zland
313            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
314            !
315         CASE DEFAULT                             !**  North closed  --  South closed
316            SELECT CASE ( cd_type )
317            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
318               pt2d(:, 1 ) = zland
319               pt2d(:,jpj) = zland
320            CASE ( 'F' )                               ! F-point
321               pt2d(:,jpj) = zland
322            END SELECT
323            !
324         END SELECT
325         !
326      ENDIF
327      !   
328   END SUBROUTINE lbc_lnk_2d
329
330   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
331      !!---------------------------------------------------------------------
332      !!                 ***  ROUTINE lbc_lnk_2d  ***
333      !!
334      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
335      !!                special dummy routine to allow for use of halo indexing in mpp case
336      !!
337      !! ** Method  :   psign = -1 :    change the sign across the north fold
338      !!                      =  1 : no change of the sign across the north fold
339      !!                      =  0 : no change of the sign across the north fold and
340      !!                             strict positivity preserved: use inner row/column
341      !!                             for closed boundaries.
342      !!----------------------------------------------------------------------
343      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
344      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
345      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
346      INTEGER                     , INTENT(in   )           ::   jpri      ! size of extra halo (not needed in non-mpp)
347      INTEGER                     , INTENT(in   )           ::   jprj      ! size of extra halo (not needed in non-mpp)
348      !!----------------------------------------------------------------------
349
350      CALL lbc_lnk_2d( pt2d, cd_type, psgn )
351      !   
352   END SUBROUTINE lbc_lnk_2d_e
353
354#endif
355
356   !!======================================================================
357END MODULE lbclnk
Note: See TracBrowser for help on using the repository browser.