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

source: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 4528

Last change on this file since 4528 was 4328, checked in by davestorkey, 10 years ago

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