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

source: branches/2017/dev_r7832_HPC08_lbclnk_3rd_dim/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 7897

Last change on this file since 7897 was 7897, checked in by gm, 7 years ago

#1880: (HPC-08) 3D lbc_lnk with any 3rd dim + regroup global comm in stpctl.F90

  • Property svn:keywords set to Id
File size: 30.4 KB
Line 
1MODULE lbclnk
2   !!======================================================================
3   !!                       ***  MODULE  lbclnk  ***
4   !! NEMO        : 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   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi 
12   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size)
13   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather)
14   !!----------------------------------------------------------------------
15#if defined key_mpp_mpi
16   !!----------------------------------------------------------------------
17   !!   'key_mpp_mpi'             MPI massively parallel processing library
18   !!----------------------------------------------------------------------
19   !!           define the generic interfaces of lib_mpp routines
20   !!----------------------------------------------------------------------
21   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
22   !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp
23   !!   lbc_lnk_e     : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
24   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
25   !!----------------------------------------------------------------------
26   USE lib_mpp        ! distributed memory computing library
27
28   INTERFACE lbc_lnk_multi
29      MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple
30   END INTERFACE
31   !
32   INTERFACE lbc_lnk
33      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
34   END INTERFACE
35   !
36   INTERFACE lbc_sum
37      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d
38   END INTERFACE
39   !
40   INTERFACE lbc_bdy_lnk
41      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
42   END INTERFACE
43   !
44   INTERFACE lbc_lnk_e
45      MODULE PROCEDURE mpp_lnk_2d_e
46   END INTERFACE
47   !
48   INTERFACE lbc_lnk_icb
49      MODULE PROCEDURE mpp_lnk_2d_icb
50   END INTERFACE
51
52   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions
53   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
54   PUBLIC   lbc_sum       ! sum across processors
55   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions
56   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
57   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
58
59   !!----------------------------------------------------------------------
60   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
61   !! $Id$
62   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
63   !!----------------------------------------------------------------------
64#else
65   !!----------------------------------------------------------------------
66   !!   Default option                              shared memory computing
67   !!----------------------------------------------------------------------
68   !!                routines setting the appropriate values
69   !!         on first and last row and column of the global domain
70   !!----------------------------------------------------------------------
71   !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d
72   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh
73   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh
74   !!   lbc_lnk       : generic interface for lbc_lnk_3d and lbc_lnk_2d
75   !!   lbc_lnk_3d    : set the lateral boundary condition on a 3D variable on ocean mesh
76   !!   lbc_lnk_2d    : set the lateral boundary condition on a 2D variable on ocean mesh
77   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition
78   !!----------------------------------------------------------------------
79   USE oce            ! ocean dynamics and tracers   
80   USE dom_oce        ! ocean space and time domain
81   USE in_out_manager ! I/O manager
82   USE lbcnfd         ! north fold
83
84   IMPLICIT NONE
85   PRIVATE
86
87   INTERFACE lbc_lnk
88      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
89   END INTERFACE
90   !
91   INTERFACE lbc_sum
92      MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d
93   END INTERFACE
94   !
95   INTERFACE lbc_lnk_e
96      MODULE PROCEDURE lbc_lnk_2d_e
97   END INTERFACE
98   !
99   INTERFACE lbc_lnk_multi
100      MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple
101   END INTERFACE
102   !
103   INTERFACE lbc_bdy_lnk
104      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
105   END INTERFACE
106   !
107   INTERFACE lbc_lnk_icb
108      MODULE PROCEDURE lbc_lnk_2d_e
109   END INTERFACE
110   
111   TYPE arrayptr
112      REAL , DIMENSION (:,:),  POINTER :: pt2d
113   END TYPE arrayptr
114   !
115   PUBLIC   arrayptr
116
117   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
118   PUBLIC   lbc_sum       ! ocean/ice  lateral boundary conditions (sum of the overlap region)
119   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions
120   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
121   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
122   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
123   
124   !!----------------------------------------------------------------------
125   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
126   !! $Id$
127   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
128   !!----------------------------------------------------------------------
129CONTAINS
130
131# if defined key_c1d
132   !!----------------------------------------------------------------------
133   !!   'key_c1d'                                          1D configuration
134   !!----------------------------------------------------------------------
135   !!     central point value replicated over the 8 surrounding points
136   !!----------------------------------------------------------------------
137
138   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
139      !!---------------------------------------------------------------------
140      !!                  ***  ROUTINE lbc_lnk_3d  ***
141      !!
142      !! ** Purpose :   set lateral boundary conditions on a 3D array (C1D case)
143      !!
144      !! ** Method  :   1D case, the central water column is set everywhere
145      !!----------------------------------------------------------------------
146      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
147      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
148      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold
149      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
150      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
151      !
152      INTEGER  ::   jk     ! dummy loop index
153      REAL(wp) ::   ztab   ! local scalar
154      !!----------------------------------------------------------------------
155      !
156      DO jk = 1, SIZE( pt3d, 3 )
157         ztab = pt3d(2,2,jk)
158         pt3d(:,:,jk) = ztab
159      END DO
160      !
161   END SUBROUTINE lbc_lnk_3d
162
163
164   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
165      !!---------------------------------------------------------------------
166      !!                 ***  ROUTINE lbc_lnk_2d  ***
167      !!
168      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
169      !!
170      !! ** Method  :   1D case, the central water column is set everywhere
171      !!----------------------------------------------------------------------
172      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
173      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
174      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold
175      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
176      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
177      !
178      REAL(wp) ::   ztab   ! local scalar
179      !!----------------------------------------------------------------------
180      !
181      ztab = pt2d(2,2)
182      pt2d(:,:) = ztab
183      !
184   END SUBROUTINE lbc_lnk_2d
185   
186#else
187   !!----------------------------------------------------------------------
188   !!   Default option                           3D shared memory computing
189   !!----------------------------------------------------------------------
190   !!          routines setting land point, or east-west cyclic,
191   !!             or north-south cyclic, or north fold values
192   !!         on first and last row and column of the global domain
193   !!----------------------------------------------------------------------
194
195   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
196      !!---------------------------------------------------------------------
197      !!                  ***  ROUTINE lbc_lnk_3d  ***
198      !!
199      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
200      !!
201      !! ** Method  :   psign = -1 :    change the sign across the north fold
202      !!                      =  1 : no change of the sign across the north fold
203      !!                      =  0 : no change of the sign across the north fold and
204      !!                             strict positivity preserved: use inner row/column
205      !!                             for closed boundaries.
206      !!----------------------------------------------------------------------
207      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
208      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
209      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold
210      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
211      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
212      !
213      REAL(wp) ::   zland
214      !!----------------------------------------------------------------------
215      !
216      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
217      ELSE                         ;   zland = 0._wp
218      ENDIF
219      !
220      IF( PRESENT( cd_mpp ) ) THEN
221         ! only fill the overlap area and extra allows
222         ! this is in mpp case. In this module, just do nothing
223      ELSE
224         !                                     !  East-West boundaries
225         !                                     ! ======================
226         SELECT CASE ( nperio )
227         !
228         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
229            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
230            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
231            !
232         CASE DEFAULT                             !**  East closed  --  West closed
233            SELECT CASE ( cd_type )
234            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
235               pt3d( 1 ,:,:) = zland
236               pt3d(jpi,:,:) = zland
237            CASE ( 'F' )                               ! F-point
238               pt3d(jpi,:,:) = zland
239            END SELECT
240            !
241         END SELECT
242         !                                     ! North-South boundaries
243         !                                     ! ======================
244         SELECT CASE ( nperio )
245         !
246         CASE ( 2 )                               !**  South symmetric  --  North closed
247            SELECT CASE ( cd_type )
248            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
249               pt3d(:, 1 ,:) = pt3d(:,3,:)
250               pt3d(:,jpj,:) = zland
251            CASE ( 'V' , 'F' )                         ! V-, F-points
252               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
253               pt3d(:,jpj,:) = zland
254            END SELECT
255            !
256         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
257            SELECT CASE ( cd_type )                    ! South : closed
258            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
259               pt3d(:, 1 ,:) = zland
260            END SELECT
261            !                                          ! North fold
262            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
263            !
264         CASE DEFAULT                             !**  North closed  --  South closed
265            SELECT CASE ( cd_type )
266            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
267               pt3d(:, 1 ,:) = zland
268               pt3d(:,jpj,:) = zland
269            CASE ( 'F' )                               ! F-point
270               pt3d(:,jpj,:) = zland
271            END SELECT
272            !
273         END SELECT
274         !
275      ENDIF
276      !
277   END SUBROUTINE lbc_lnk_3d
278
279
280   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
281      !!---------------------------------------------------------------------
282      !!                 ***  ROUTINE lbc_lnk_2d  ***
283      !!
284      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
285      !!
286      !! ** Method  :   psign = -1 :    change the sign across the north fold
287      !!                      =  1 : no change of the sign across the north fold
288      !!                      =  0 : no change of the sign across the north fold and
289      !!                             strict positivity preserved: use inner row/column
290      !!                             for closed boundaries.
291      !!----------------------------------------------------------------------
292      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
293      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
294      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold
295      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
296      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
297      !!
298      REAL(wp) ::   zland
299      !!----------------------------------------------------------------------
300
301      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
302      ELSE                         ;   zland = 0._wp
303      ENDIF
304
305      IF (PRESENT(cd_mpp)) THEN
306         ! only fill the overlap area and extra allows
307         ! this is in mpp case. In this module, just do nothing
308      ELSE     
309         !                                     ! East-West boundaries
310         !                                     ! ====================
311         SELECT CASE ( nperio )
312         !
313         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
314            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
315            pt2d(jpi,:) = pt2d(  2  ,:)
316            !
317         CASE DEFAULT                             !** East closed  --  West closed
318            SELECT CASE ( cd_type )
319            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
320               pt2d( 1 ,:) = zland
321               pt2d(jpi,:) = zland
322            CASE ( 'F' )                              ! F-point
323               pt2d(jpi,:) = zland
324            END SELECT
325            !
326         END SELECT
327         !                                     ! North-South boundaries
328         !                                     ! ======================
329         SELECT CASE ( nperio )
330         !
331         CASE ( 2 )                               !**  South symmetric  --  North closed
332            SELECT CASE ( cd_type )
333            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
334               pt2d(:, 1 ) = pt2d(:,3)
335               pt2d(:,jpj) = zland
336            CASE ( 'V' , 'F' )                         ! V-, F-points
337               pt2d(:, 1 ) = psgn * pt2d(:,2)
338               pt2d(:,jpj) = zland
339            END SELECT
340            !
341         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
342            SELECT CASE ( cd_type )                    ! South : closed
343            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
344               pt2d(:, 1 ) = zland
345            END SELECT
346            !                                          ! North fold
347            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
348            !
349         CASE DEFAULT                             !**  North closed  --  South closed
350            SELECT CASE ( cd_type )
351            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
352               pt2d(:, 1 ) = zland
353               pt2d(:,jpj) = zland
354            CASE ( 'F' )                               ! F-point
355               pt2d(:,jpj) = zland
356            END SELECT
357            !
358         END SELECT
359         !
360      ENDIF
361      !   
362   END SUBROUTINE lbc_lnk_2d
363   
364#endif
365
366   !!----------------------------------------------------------------------
367   !!   identical routines in both C1D and shared memory computing cases
368   !!----------------------------------------------------------------------
369
370   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
371      !!---------------------------------------------------------------------
372      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
373      !!
374      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case)
375      !!
376      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2
377      !!----------------------------------------------------------------------
378      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
379      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d1 & pt3d2 grid-points
380      REAL(wp)                  , INTENT(in   ) ::   psgn                 ! sign used across north fold
381      !!----------------------------------------------------------------------
382      !
383      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
384      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
385      !
386   END SUBROUTINE lbc_lnk_3d_gather
387
388 
389   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array, type_array, psgn_array, kfld )
390      !!---------------------------------------------------------------------
391      TYPE( arrayptr ), DIMENSION(:), INTENT(inout) ::   pt2d_array   ! pointer array of 2D fields
392      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! nature of ptab_array grid-points
393      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! sign used across the north fold boundary
394      INTEGER                       , INTENT(in   ) ::   kfld         ! number of 2D fields
395      !
396      INTEGER  ::   jf    !dummy loop index
397      !!---------------------------------------------------------------------
398      !
399      DO jf = 1, kfld
400        CALL lbc_lnk_2d( pt2d_array(jf)%pt2d, type_array(jf), psgn_array(jf) )
401      END DO     
402      !
403   END SUBROUTINE lbc_lnk_2d_multiple
404
405
406   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC,   &
407      &                     pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF,   &
408      &                     pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI,   &
409      &                     cd_mpp, pval )
410      !!---------------------------------------------------------------------
411      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    ! 2D arrays on which the lbc is applied
412      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
413      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
414      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA ! nature of pt2D. array grid-points
415      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
416      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
417      REAL(wp)                                      , INTENT(in   ) ::   psgnA    ! sign used across the north fold
418      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
419      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
420      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
421      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
422      !!
423      !!---------------------------------------------------------------------
424      !
425                              CALL lbc_lnk( pt2dA, cd_typeA, psgnA )    ! The first array
426      !         
427      IF( PRESENT (psgnB) )   CALL lbc_lnk( pt2dB, cd_typeB, psgnB )    ! Look if more arrays to process
428      IF( PRESENT (psgnC) )   CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 
429      IF( PRESENT (psgnD) )   CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 
430      IF( PRESENT (psgnE) )   CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 
431      IF( PRESENT (psgnF) )   CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 
432      IF( PRESENT (psgnG) )   CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 
433      IF( PRESENT (psgnH) )   CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 
434      IF( PRESENT (psgnI) )   CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 
435      !
436   END SUBROUTINE lbc_lnk_2d_9
437
438
439   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
440      !!---------------------------------------------------------------------
441      !!                  ***  ROUTINE lbc_bdy_lnk  ***
442      !!
443      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
444      !!              to maintain the same interface with regards to the mpp case
445      !!----------------------------------------------------------------------
446      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
447      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
448      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold
449      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
450      !!----------------------------------------------------------------------
451      !
452      CALL lbc_lnk_3d( pt3d, cd_type, psgn)
453      !
454   END SUBROUTINE lbc_bdy_lnk_3d
455
456
457   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
458      !!---------------------------------------------------------------------
459      !!                  ***  ROUTINE lbc_bdy_lnk  ***
460      !!
461      !! ** Purpose :   wrapper rountine to 'lbc_lnk_2d'. This wrapper is used
462      !!              to maintain the same interface with regards to the mpp case
463      !!----------------------------------------------------------------------
464      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
465      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
466      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
467      INTEGER                 , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
468      !!----------------------------------------------------------------------
469      !
470      CALL lbc_lnk_2d( pt2d, cd_type, psgn)
471      !
472   END SUBROUTINE lbc_bdy_lnk_2d
473
474
475   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, ki, kj )
476      !!---------------------------------------------------------------------
477      !!                 ***  ROUTINE lbc_lnk_2d  ***
478      !!
479      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
480      !!                special dummy routine to allow for use of halo indexing in mpp case
481      !!----------------------------------------------------------------------
482      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
483      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
484      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
485      INTEGER                 , INTENT(in   ) ::   ki, kj    ! sizes of extra halo (not needed in non-mpp)
486      !!----------------------------------------------------------------------
487      !
488      CALL lbc_lnk_2d( pt2d, cd_type, psgn )
489      !   
490   END SUBROUTINE lbc_lnk_2d_e
491
492
493   SUBROUTINE lbc_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
494      !!---------------------------------------------------------------------
495      !!                 ***  ROUTINE lbc_lnk_sum_2d  ***
496      !!
497      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
498      !!
499      !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean
500      !!                coupling if conservation option activated. As no ice shelf are present along
501      !!                this line, nothing is done along the north fold.
502      !!----------------------------------------------------------------------
503      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
504      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
505      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold
506      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
507      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
508      !!
509      REAL(wp) ::   zland
510      !!----------------------------------------------------------------------
511      !
512      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
513      ELSE                         ;   zland = 0._wp
514      ENDIF
515      !
516      IF (PRESENT(cd_mpp)) THEN
517         ! only fill the overlap area and extra allows
518         ! this is in mpp case. In this module, just do nothing
519      ELSE
520         !                                     ! East-West boundaries
521         !                                     ! ====================
522         SELECT CASE ( nperio )
523         !
524         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
525            pt2d(jpim1,:) = pt2d(jpim1,:) + pt2d( 1 ,:)
526            pt2d(  2  ,:) = pt2d(  2  ,:) + pt2d(jpi,:)
527            pt2d( 1 ,:) = 0.0_wp               ! all points
528            pt2d(jpi,:) = 0.0_wp
529            !
530         CASE DEFAULT                             !** East closed  --  West closed
531            SELECT CASE ( cd_type )
532            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
533               pt2d( 1 ,:) = zland
534               pt2d(jpi,:) = zland
535            CASE ( 'F' )                              ! F-point
536               pt2d(jpi,:) = zland
537            END SELECT
538            !
539         END SELECT
540         !                                     ! North-South boundaries
541         !                                     ! ======================
542         ! Nothing to do for the north fold, there is no ice shelf along this line.
543         !
544      END IF
545      !
546   END SUBROUTINE
547
548
549   SUBROUTINE lbc_lnk_sum_3d( pt3d, cd_type, psgn, cd_mpp, pval )
550      !!---------------------------------------------------------------------
551      !!                 ***  ROUTINE lbc_lnk_sum_3d  ***
552      !!
553      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
554      !!
555      !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean
556      !!                coupling if conservation option activated. As no ice shelf are present along
557      !!                this line, nothing is done along the north fold.
558      !!----------------------------------------------------------------------
559      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
560      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
561      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold
562      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
563      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
564      !
565      REAL(wp) ::   zland
566      !!----------------------------------------------------------------------
567      !
568      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
569      ELSE                         ;   zland = 0._wp
570      ENDIF
571      !
572      IF( PRESENT( cd_mpp ) ) THEN
573         ! only fill the overlap area and extra allows
574         ! this is in mpp case. In this module, just do nothing
575      ELSE
576         !                                     !  East-West boundaries
577         !                                     ! ======================
578         SELECT CASE ( nperio )
579         !
580         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
581            pt3d(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:)
582            pt3d(  2  ,:,:) = pt3d(  2  ,:,:) + pt3d(jpi,:,:) 
583            pt3d( 1 ,:,:) = 0._wp
584            pt3d(jpi,:,:) = 0._wp
585            !
586         CASE DEFAULT                             !**  East closed  --  West closed
587            SELECT CASE ( cd_type )
588            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
589               pt3d( 1 ,:,:) = zland
590               pt3d(jpi,:,:) = zland
591            CASE ( 'F' )                               ! F-point
592               pt3d(jpi,:,:) = zland
593            END SELECT
594            !
595         END SELECT
596         !                                     ! North-South boundaries
597         !                                     ! ======================
598         ! Nothing to do for the north fold, there is no ice shelf along this line.
599         !
600      END IF
601      !
602   END SUBROUTINE
603
604#endif
605
606   !!======================================================================
607END MODULE lbclnk
608
Note: See TracBrowser for help on using the repository browser.