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

source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 4153

Last change on this file since 4153 was 4153, checked in by cetlod, 10 years ago

dev_LOCEAN_2013: merge in trunk changes between r3940 and r4028, see ticket #1169

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