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

source: branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 6069

Last change on this file since 6069 was 6069, checked in by timgraham, 8 years ago

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