New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
lbclnk.F90 in trunk/NEMO/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/lbclnk.F90 @ 896

Last change on this file since 896 was 888, checked in by ctlod, 16 years ago

merge dev_001_SBC branche with the trunk to include the New Surface Module package, see ticket: #113

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 28.7 KB
Line 
1MODULE lbclnk
2   !!======================================================================
3   !!                       ***  MODULE  lbclnk  ***
4   !! Ocean        : lateral boundary conditions
5   !!=====================================================================
6#if   defined key_mpp_mpi   ||   defined key_mpp_shmem
7   !!----------------------------------------------------------------------
8   !!   'key_mpp_mpi'     OR      MPI massively parallel processing library
9   !!   'key_mpp_shmem'         SHMEM massively parallel processing library
10   !!----------------------------------------------------------------------
11   !!----------------------------------------------------------------------
12   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d
13   !!                  routines defined in lib_mpp
14   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e
15   !!                   routinee defined in lib_mpp
16   !!----------------------------------------------------------------------
17   !! * Modules used
18   USE lib_mpp          ! distributed memory computing library
19
20   INTERFACE lbc_lnk
21      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
22   END INTERFACE
23
24   INTERFACE lbc_lnk_e
25      MODULE PROCEDURE mpp_lnk_2d_e
26   END INTERFACE
27
28   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
29   PUBLIC lbc_lnk_e
30   !!----------------------------------------------------------------------
31
32#else
33   !!----------------------------------------------------------------------
34   !!   Default option                              shared memory computing
35   !!----------------------------------------------------------------------
36   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
37   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable
38   !!                  on OPA ocean mesh
39   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable
40   !!                  on OPA ocean mesh
41   !!----------------------------------------------------------------------
42   !! * Modules used
43   USE oce             ! ocean dynamics and tracers   
44   USE dom_oce         ! ocean space and time domain
45   USE in_out_manager  ! I/O manager
46
47   IMPLICIT NONE
48   PRIVATE
49
50   INTERFACE lbc_lnk
51      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
52   END INTERFACE
53
54   INTERFACE lbc_lnk_e
55      MODULE PROCEDURE lbc_lnk_2d
56   END INTERFACE
57
58   PUBLIC lbc_lnk       ! ocean/ice  lateral boundary conditions
59   PUBLIC  lbc_lnk_e 
60   !!----------------------------------------------------------------------
61
62CONTAINS
63
64   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
65      !!---------------------------------------------------------------------
66      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
67      !!
68      !! ** Purpose :   set lateral boundary conditions (non mpp case)
69      !!
70      !! ** Method  :
71      !!
72      !! History :
73      !!        !  97-06  (G. Madec)  Original code
74      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
75      !!----------------------------------------------------------------------
76      !! * Arguments
77      CHARACTER(len=1), INTENT( in ) ::   &
78         cd_type1, cd_type2       ! nature of pt3d grid-points
79         !             !   = T ,  U , V , F or W  gridpoints
80      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
81         pt3d1, pt3d2          ! 3D array on which the boundary condition is applied
82      REAL(wp), INTENT( in ) ::   &
83         psgn          ! control of the sign change
84         !             !   =-1 , the sign is changed if north fold boundary
85         !             !   = 1 , no sign change
86         !             !   = 0 , no sign change and > 0 required (use the inner
87         !             !         row/column if closed boundary)
88
89     
90      !! * Local declarations
91      INTEGER  ::   ji, jk
92      INTEGER  ::   ijt, iju
93      !!----------------------------------------------------------------------
94      !!  OPA 9.0 , LOCEAN-IPSL (2005)
95      !! $Id$
96      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
97      !!----------------------------------------------------------------------
98     
99      !                                                      ! ===============
100      DO jk = 1, jpk                                         ! Horizontal slab
101         !                                                   ! ===============
102
103         !                                     ! East-West boundaries
104         !                                     ! ====================
105         SELECT CASE ( nperio )
106
107         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west
108            pt3d1( 1 ,:,jk) = pt3d1(jpim1,:,jk)          ! all points
109            pt3d1(jpi,:,jk) = pt3d1(  2  ,:,jk)
110            pt3d2( 1 ,:,jk) = pt3d2(jpim1,:,jk)         
111            pt3d2(jpi,:,jk) = pt3d2(  2  ,:,jk)
112
113         CASE DEFAULT                          ! * closed
114            SELECT CASE ( cd_type1 )
115            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
116               pt3d1( 1 ,:,jk) = 0.e0
117               pt3d1(jpi,:,jk) = 0.e0
118            CASE ( 'F' )                               ! F-point
119               pt3d1(jpi,:,jk) = 0.e0
120            END SELECT
121            SELECT CASE ( cd_type2 )
122            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
123               pt3d2( 1 ,:,jk) = 0.e0
124               pt3d2(jpi,:,jk) = 0.e0
125            CASE ( 'F' )                               ! F-point
126               pt3d2(jpi,:,jk) = 0.e0
127            END SELECT
128
129         END SELECT
130
131         !                                     ! North-South boundaries
132         !                                     ! ======================
133         SELECT CASE ( nperio )
134
135         CASE ( 2 )                            ! *  south symmetric
136
137            SELECT CASE ( cd_type1 )
138            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
139               pt3d1(:, 1 ,jk) = pt3d1(:,3,jk)
140               pt3d1(:,jpj,jk) = 0.e0
141            CASE ( 'V' , 'F' )                         ! V-, F-points
142               pt3d1(:, 1 ,jk) = psgn * pt3d1(:,2,jk)
143               pt3d1(:,jpj,jk) = 0.e0
144            END SELECT
145            SELECT CASE ( cd_type2 )
146            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
147               pt3d2(:, 1 ,jk) = pt3d2(:,3,jk)
148               pt3d2(:,jpj,jk) = 0.e0
149            CASE ( 'V' , 'F' )                         ! V-, F-points
150               pt3d2(:, 1 ,jk) = psgn * pt3d2(:,2,jk)
151               pt3d2(:,jpj,jk) = 0.e0
152            END SELECT
153
154         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
155
156            pt3d1( 1 ,jpj,jk) = 0.e0
157            pt3d1(jpi,jpj,jk) = 0.e0
158            pt3d2( 1 ,jpj,jk) = 0.e0
159            pt3d2(jpi,jpj,jk) = 0.e0
160
161            SELECT CASE ( cd_type1 )
162            CASE ( 'T' , 'W' )                         ! T-, W-point
163               DO ji = 2, jpi
164                  ijt = jpi-ji+2
165                  pt3d1(ji, 1 ,jk) = 0.e0
166                  pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-2,jk)
167               END DO
168               DO ji = jpi/2+1, jpi
169                  ijt = jpi-ji+2
170                  pt3d1(ji,jpjm1,jk) = psgn * pt3d1(ijt,jpjm1,jk)
171               END DO
172            CASE ( 'U' )                               ! U-point
173               DO ji = 1, jpi-1
174                  iju = jpi-ji+1
175                  pt3d1(ji, 1 ,jk) = 0.e0
176                  pt3d1(ji,jpj,jk) = psgn * pt3d1(iju,jpj-2,jk)
177               END DO
178               DO ji = jpi/2, jpi-1
179                  iju = jpi-ji+1
180                  pt3d1(ji,jpjm1,jk) = psgn * pt3d1(iju,jpjm1,jk)
181               END DO
182            CASE ( 'V' )                               ! V-point
183                  DO ji = 2, jpi
184                     ijt = jpi-ji+2
185                     pt3d1(ji,  1  ,jk) = 0.e0
186                     pt3d1(ji,jpj-1,jk) = psgn * pt3d1(ijt,jpj-2,jk)
187                     pt3d1(ji,jpj  ,jk) = psgn * pt3d1(ijt,jpj-3,jk)
188                  END DO
189            CASE ( 'F' )                               ! F-point
190                  DO ji = 1, jpi-1
191                     iju = jpi-ji+1
192                     pt3d1(ji,jpj-1,jk) = psgn * pt3d1(iju,jpj-2,jk)
193                     pt3d1(ji,jpj  ,jk) = psgn * pt3d1(iju,jpj-3,jk)
194                  END DO
195            END SELECT
196            SELECT CASE ( cd_type2 )
197            CASE ( 'T' , 'W' )                         ! T-, W-point
198               DO ji = 2, jpi
199                  ijt = jpi-ji+2
200                  pt3d2(ji, 1 ,jk) = 0.e0
201                  pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-2,jk)
202               END DO
203               DO ji = jpi/2+1, jpi
204                  ijt = jpi-ji+2
205                  pt3d2(ji,jpjm1,jk) = psgn * pt3d2(ijt,jpjm1,jk)
206               END DO
207            CASE ( 'U' )                               ! U-point
208               DO ji = 1, jpi-1
209                  iju = jpi-ji+1
210                  pt3d2(ji, 1 ,jk) = 0.e0
211                  pt3d2(ji,jpj,jk) = psgn * pt3d2(iju,jpj-2,jk)
212               END DO
213               DO ji = jpi/2, jpi-1
214                  iju = jpi-ji+1
215                  pt3d2(ji,jpjm1,jk) = psgn * pt3d2(iju,jpjm1,jk)
216               END DO
217            CASE ( 'V' )                               ! V-point
218                  DO ji = 2, jpi
219                     ijt = jpi-ji+2
220                     pt3d2(ji,  1  ,jk) = 0.e0
221                     pt3d2(ji,jpj-1,jk) = psgn * pt3d2(ijt,jpj-2,jk)
222                     pt3d2(ji,jpj  ,jk) = psgn * pt3d2(ijt,jpj-3,jk)
223                  END DO
224            CASE ( 'F' )                               ! F-point
225                  DO ji = 1, jpi-1
226                     iju = jpi-ji+1
227                     pt3d2(ji,jpj-1,jk) = psgn * pt3d2(iju,jpj-2,jk)
228                     pt3d2(ji,jpj  ,jk) = psgn * pt3d2(iju,jpj-3,jk)
229                  END DO
230            END SELECT
231
232         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
233
234            pt3d1( 1 ,jpj,jk) = 0.e0
235            pt3d1(jpi,jpj,jk) = 0.e0
236            pt3d2( 1 ,jpj,jk) = 0.e0
237            pt3d2(jpi,jpj,jk) = 0.e0
238
239            SELECT CASE ( cd_type1 )
240            CASE ( 'T' , 'W' )                         ! T-, W-point
241               DO ji = 1, jpi
242                  ijt = jpi-ji+1
243                  pt3d1(ji, 1 ,jk) = 0.e0
244                  pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-1,jk)
245               END DO
246            CASE ( 'U' )                               ! U-point
247                  DO ji = 1, jpi-1
248                     iju = jpi-ji
249                     pt3d1(ji, 1 ,jk) = 0.e0
250                     pt3d1(ji,jpj,jk) = psgn * pt3d1(iju,jpj-1,jk)
251                  END DO
252            CASE ( 'V' )                               ! V-point
253                  DO ji = 1, jpi
254                     ijt = jpi-ji+1
255                     pt3d1(ji, 1 ,jk) = 0.e0
256                     pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-2,jk)
257                  END DO
258                  DO ji = jpi/2+1, jpi
259                     ijt = jpi-ji+1
260                     pt3d1(ji,jpjm1,jk) = psgn * pt3d1(ijt,jpjm1,jk)
261                  END DO
262            CASE ( 'F' )                               ! F-point
263                  DO ji = 1, jpi-1
264                     iju = jpi-ji
265                     pt3d1(ji,jpj  ,jk) = psgn * pt3d1(iju,jpj-2,jk)
266                  END DO
267                  DO ji = jpi/2+1, jpi-1
268                     iju = jpi-ji
269                     pt3d1(ji,jpjm1,jk) = psgn * pt3d1(iju,jpjm1,jk)
270                  END DO
271            END SELECT
272            SELECT CASE ( cd_type2 )
273            CASE ( 'T' , 'W' )                         ! T-, W-point
274               DO ji = 1, jpi
275                  ijt = jpi-ji+1
276                  pt3d2(ji, 1 ,jk) = 0.e0
277                  pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-1,jk)
278               END DO
279            CASE ( 'U' )                               ! U-point
280                  DO ji = 1, jpi-1
281                     iju = jpi-ji
282                     pt3d2(ji, 1 ,jk) = 0.e0
283                     pt3d2(ji,jpj,jk) = psgn * pt3d2(iju,jpj-1,jk)
284                  END DO
285            CASE ( 'V' )                               ! V-point
286                  DO ji = 1, jpi
287                     ijt = jpi-ji+1
288                     pt3d2(ji, 1 ,jk) = 0.e0
289                     pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-2,jk)
290                  END DO
291                  DO ji = jpi/2+1, jpi
292                     ijt = jpi-ji+1
293                     pt3d2(ji,jpjm1,jk) = psgn * pt3d2(ijt,jpjm1,jk)
294                  END DO
295            CASE ( 'F' )                               ! F-point
296                  DO ji = 1, jpi-1
297                     iju = jpi-ji
298                     pt3d2(ji,jpj  ,jk) = psgn * pt3d2(iju,jpj-2,jk)
299                  END DO
300                  DO ji = jpi/2+1, jpi-1
301                     iju = jpi-ji
302                     pt3d2(ji,jpjm1,jk) = psgn * pt3d2(iju,jpjm1,jk)
303                  END DO
304            END SELECT
305
306         CASE DEFAULT                          ! *  closed
307
308            SELECT CASE ( cd_type1 )
309            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
310               pt3d1(:, 1 ,jk) = 0.e0
311               pt3d1(:,jpj,jk) = 0.e0
312            CASE ( 'F' )                               ! F-point
313               pt3d1(:,jpj,jk) = 0.e0
314            END SELECT
315            SELECT CASE ( cd_type2 )
316            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
317               pt3d2(:, 1 ,jk) = 0.e0
318               pt3d2(:,jpj,jk) = 0.e0
319            CASE ( 'F' )                               ! F-point
320               pt3d2(:,jpj,jk) = 0.e0
321            END SELECT
322
323         END SELECT
324         !                                                   ! ===============
325      END DO                                                 !   End of slab
326      !                                                      ! ===============
327
328   END SUBROUTINE lbc_lnk_3d_gather
329
330
331   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
332      !!---------------------------------------------------------------------
333      !!                  ***  ROUTINE lbc_lnk_3d  ***
334      !!
335      !! ** Purpose :   set lateral boundary conditions (non mpp case)
336      !!
337      !! ** Method  :
338      !!
339      !! History :
340      !!        !  97-06  (G. Madec)  Original code
341      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
342      !!----------------------------------------------------------------------
343      !! * Arguments
344      CHARACTER(len=1), INTENT( in ) ::   &
345         cd_type       ! nature of pt3d grid-points
346         !             !   = T ,  U , V , F or W  gridpoints
347      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
348         pt3d          ! 3D array on which the boundary condition is applied
349      REAL(wp), INTENT( in ) ::   &
350         psgn          ! control of the sign change
351         !             !   =-1 , the sign is changed if north fold boundary
352         !             !   = 1 , no sign change
353         !             !   = 0 , no sign change and > 0 required (use the inner
354         !             !         row/column if closed boundary)
355      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
356         cd_mpp        ! fill the overlap area only (here do nothing)
357      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
358
359      !! * Local declarations
360      INTEGER  ::   ji, jk
361      INTEGER  ::   ijt, iju
362      REAL(wp) ::   zland
363      !!----------------------------------------------------------------------
364      !!  OPA 9.0 , LOCEAN-IPSL (2005)
365      !! $Id$
366      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
367      !!----------------------------------------------------------------------
368
369      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
370         zland = pval
371      ELSE
372         zland = 0.e0
373      ENDIF
374
375
376      IF( PRESENT( cd_mpp ) ) THEN
377         ! only fill the overlap area and extra allows
378         ! this is in mpp case. In this module, just do nothing
379      ELSE
380     
381      !                                                      ! ===============
382      DO jk = 1, jpk                                         ! Horizontal slab
383         !                                                   ! ===============
384
385         !                                     ! East-West boundaries
386         !                                     ! ====================
387         SELECT CASE ( nperio )
388
389         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west
390            pt3d( 1 ,:,jk) = pt3d(jpim1,:,jk)          ! all points
391            pt3d(jpi,:,jk) = pt3d(  2  ,:,jk)
392
393         CASE DEFAULT                          ! * closed
394            SELECT CASE ( cd_type )
395            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
396               pt3d( 1 ,:,jk) = zland
397               pt3d(jpi,:,jk) = zland
398            CASE ( 'F' )                               ! F-point
399               pt3d(jpi,:,jk) = zland
400            END SELECT
401
402         END SELECT
403
404         !                                     ! North-South boundaries
405         !                                     ! ======================
406         SELECT CASE ( nperio )
407
408         CASE ( 2 )                            ! *  south symmetric
409
410            SELECT CASE ( cd_type )
411            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
412               pt3d(:, 1 ,jk) = pt3d(:,3,jk)
413               pt3d(:,jpj,jk) = zland
414            CASE ( 'V' , 'F' )                         ! V-, F-points
415               pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk)
416               pt3d(:,jpj,jk) = zland
417            END SELECT
418
419         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
420
421            pt3d( 1 ,jpj,jk) = zland
422            pt3d(jpi,jpj,jk) = zland
423
424            SELECT CASE ( cd_type )
425            CASE ( 'T' , 'W' )                         ! T-, W-point
426               DO ji = 2, jpi
427                  ijt = jpi-ji+2
428                  pt3d(ji, 1 ,jk) = zland
429                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
430               END DO
431               DO ji = jpi/2+1, jpi
432                  ijt = jpi-ji+2
433                  pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
434               END DO
435            CASE ( 'U' )                               ! U-point
436               DO ji = 1, jpi-1
437                  iju = jpi-ji+1
438                  pt3d(ji, 1 ,jk) = zland
439                  pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk)
440               END DO
441               DO ji = jpi/2, jpi-1
442                  iju = jpi-ji+1
443                  pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
444               END DO
445            CASE ( 'V' )                               ! V-point
446                  DO ji = 2, jpi
447                     ijt = jpi-ji+2
448                     pt3d(ji,  1  ,jk) = zland
449                     pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk)
450                     pt3d(ji,jpj  ,jk) = psgn * pt3d(ijt,jpj-3,jk)
451                  END DO
452            CASE ( 'F' )                               ! F-point
453                  DO ji = 1, jpi-1
454                     iju = jpi-ji+1
455                     pt3d(ji,jpj-1,jk) = psgn * pt3d(iju,jpj-2,jk)
456                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-3,jk)
457                  END DO
458            END SELECT
459
460         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
461
462            pt3d( 1 ,jpj,jk) = zland
463            pt3d(jpi,jpj,jk) = zland
464
465            SELECT CASE ( cd_type )
466            CASE ( 'T' , 'W' )                         ! T-, W-point
467               DO ji = 1, jpi
468                  ijt = jpi-ji+1
469                  pt3d(ji, 1 ,jk) = zland
470                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk)
471               END DO
472            CASE ( 'U' )                               ! U-point
473                  DO ji = 1, jpi-1
474                     iju = jpi-ji
475                     pt3d(ji, 1 ,jk) = zland
476                     pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk)
477                  END DO
478            CASE ( 'V' )                               ! V-point
479                  DO ji = 1, jpi
480                     ijt = jpi-ji+1
481                     pt3d(ji, 1 ,jk) = zland
482                     pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
483                  END DO
484                  DO ji = jpi/2+1, jpi
485                     ijt = jpi-ji+1
486                     pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
487                  END DO
488            CASE ( 'F' )                               ! F-point
489                  DO ji = 1, jpi-1
490                     iju = jpi-ji
491                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-2,jk)
492                  END DO
493                  DO ji = jpi/2+1, jpi-1
494                     iju = jpi-ji
495                     pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
496                  END DO
497            END SELECT
498
499         CASE DEFAULT                          ! *  closed
500
501            SELECT CASE ( cd_type )
502            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
503               pt3d(:, 1 ,jk) = zland
504               pt3d(:,jpj,jk) = zland
505            CASE ( 'F' )                               ! F-point
506               pt3d(:,jpj,jk) = zland
507            END SELECT
508
509         END SELECT
510         !                                                   ! ===============
511      END DO                                                 !   End of slab
512      !                                                      ! ===============
513   ENDIF
514   END SUBROUTINE lbc_lnk_3d
515
516
517   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
518      !!---------------------------------------------------------------------
519      !!                 ***  ROUTINE lbc_lnk_2d  ***
520      !!
521      !! ** Purpose :   set lateral boundary conditions (non mpp case)
522      !!
523      !! ** Method  :
524      !!
525      !! History :
526      !!        !  97-06  (G. Madec)  Original code
527      !!        !  01-05  (E. Durand)  correction
528      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
529      !!----------------------------------------------------------------------
530      !! * Arguments
531      CHARACTER(len=1), INTENT( in ) ::   &
532         cd_type       ! nature of pt2d grid-point
533         !             !   = T , U , V , F or W  gridpoints
534         !             !   = I sea-ice U-V gridpoint (= F ocean grid point with indice shift)
535      REAL(wp), INTENT( in ) ::   &
536         psgn          ! control of the sign change
537         !             !   =-1 , the sign is modified following the type of b.c. used
538         !             !   = 1 , no sign change
539      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
540         pt2d          ! 2D array on which the boundary condition is applied
541      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
542         cd_mpp        ! fill the overlap area only (here do nothing)
543      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
544
545      !! * Local declarations
546      INTEGER  ::   ji
547      INTEGER  ::   ijt, iju
548      REAL(wp) ::   zland
549      !!----------------------------------------------------------------------
550
551      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
552         zland = pval
553      ELSE
554         zland = 0.e0
555      ENDIF
556
557      IF (PRESENT(cd_mpp)) THEN
558         ! only fill the overlap area and extra allows
559         ! this is in mpp case. In this module, just do nothing
560      ELSE     
561     
562      !                                        ! East-West boundaries
563      !                                        ! ====================
564      SELECT CASE ( nperio )
565
566      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
567         pt2d( 1 ,:) = pt2d(jpim1,:)
568         pt2d(jpi,:) = pt2d(  2  ,:)
569
570      CASE DEFAULT                             ! * closed
571         SELECT CASE ( cd_type )
572         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
573            pt2d( 1 ,:) = zland
574            pt2d(jpi,:) = zland
575         CASE ( 'F' )                                  ! F-point, ice U-V point
576            pt2d(jpi,:) = zland
577         CASE ( 'I' )                                  ! F-point, ice U-V point
578            pt2d( 1 ,:) = zland
579            pt2d(jpi,:) = zland
580         END SELECT
581
582      END SELECT
583
584      !                                        ! North-South boundaries
585      !                                        ! ======================
586      SELECT CASE ( nperio )
587
588      CASE ( 2 )                               ! * South symmetric
589
590         SELECT CASE ( cd_type )
591         CASE ( 'T' , 'U' , 'W' )                      ! T-, U-, W-points
592            pt2d(:, 1 ) = pt2d(:,3)
593            pt2d(:,jpj) = zland
594         CASE ( 'V' , 'F' , 'I' )                      ! V-, F-points, ice U-V point
595            pt2d(:, 1 ) = psgn * pt2d(:,2)
596            pt2d(:,jpj) = zland
597         END SELECT
598
599      CASE ( 3 , 4 )                           ! * North fold  T-point pivot
600
601         pt2d( 1 , 1 ) = zland       !!!!!  bug gm ??? !Edmee
602         pt2d( 1 ,jpj) = zland
603         pt2d(jpi,jpj) = zland
604
605         SELECT CASE ( cd_type )
606
607         CASE ( 'T' , 'W' )                            ! T-, W-point
608            DO ji = 2, jpi
609               ijt = jpi-ji+2
610               pt2d(ji, 1 ) = zland
611               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
612            END DO
613            DO ji = jpi/2+1, jpi
614               ijt = jpi-ji+2
615               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
616            END DO
617
618         CASE ( 'U' )                                  ! U-point
619            DO ji = 1, jpi-1
620               iju = jpi-ji+1
621               pt2d(ji, 1 ) = zland
622               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2)
623            END DO
624            DO ji = jpi/2, jpi-1
625               iju = jpi-ji+1
626               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
627            END DO
628
629         CASE ( 'V' )                                  ! V-point
630            DO ji = 2, jpi
631               ijt = jpi-ji+2
632               pt2d(ji, 1   ) = zland
633               pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2)
634               pt2d(ji,jpj  ) = psgn * pt2d(ijt,jpj-3)
635            END DO
636
637         CASE ( 'F' )                                  ! F-point
638            DO ji = 1, jpi-1
639               iju = jpi - ji + 1
640               pt2d(ji,jpj-1) = psgn * pt2d(iju,jpj-2)
641               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-3)
642            END DO
643
644         CASE ( 'I' )                                  ! ice U-V point
645            pt2d(:, 1 ) = zland
646            pt2d(2,jpj) = psgn * pt2d(3,jpj-1)
647            DO ji = 3, jpi
648               iju = jpi - ji + 3
649               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
650            END DO
651
652         END SELECT
653
654      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
655
656         pt2d( 1 , 1 ) = zland          !!bug  ???
657         pt2d( 1 ,jpj) = zland
658         pt2d(jpi,jpj) = zland
659
660         SELECT CASE ( cd_type )
661
662         CASE ( 'T' , 'W' )                            ! T-, W-point
663            DO ji = 1, jpi
664               ijt = jpi-ji+1
665               pt2d(ji, 1 ) = zland
666               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1)
667            END DO
668
669         CASE ( 'U' )                                  ! U-point
670            DO ji = 1, jpi-1
671               iju = jpi-ji
672               pt2d(ji, 1 ) = zland
673               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
674            END DO
675
676         CASE ( 'V' )                                  ! V-point
677            DO ji = 1, jpi
678               ijt = jpi-ji+1
679               pt2d(ji, 1 ) = zland
680               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
681            END DO
682            DO ji = jpi/2+1, jpi
683               ijt = jpi-ji+1
684               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
685            END DO
686
687         CASE ( 'F' )                                  ! F-point
688            DO ji = 1, jpi-1
689               iju = jpi-ji
690               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-2)
691            END DO
692            DO ji = jpi/2+1, jpi-1
693               iju = jpi-ji
694               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
695            END DO
696
697         CASE ( 'I' )                                  ! ice U-V point
698            pt2d( : , 1 ) = zland
699            pt2d( 2 ,jpj) = zland
700            DO ji = 2 , jpim1
701               ijt = jpi - ji + 2
702               pt2d(ji,jpj)= 0.5 * ( pt2d(ji,jpjm1) + psgn * pt2d(ijt,jpjm1) )
703            END DO
704
705         END SELECT
706
707      CASE DEFAULT                             ! * closed
708
709         SELECT CASE ( cd_type )
710         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
711            pt2d(:, 1 ) = zland
712            pt2d(:,jpj) = zland
713         CASE ( 'F' )                                  ! F-point
714            pt2d(:,jpj) = zland
715         CASE ( 'I' )                                  ! ice U-V point
716            pt2d(:, 1 ) = zland
717            pt2d(:,jpj) = zland
718         END SELECT
719
720      END SELECT
721
722      ENDIF
723     
724   END SUBROUTINE lbc_lnk_2d
725
726#endif
727
728   !!======================================================================
729END MODULE lbclnk
Note: See TracBrowser for help on using the repository browser.