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

source: branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 5779

Last change on this file since 5779 was 5779, checked in by mathiot, 9 years ago

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