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 tags/nemo_v3_2/nemo_v3_2/NEMO/OFF_SRC – NEMO

source: tags/nemo_v3_2/nemo_v3_2/NEMO/OFF_SRC/lbclnk.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm

File size: 28.2 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: lbclnk.F90 1152 2008-06-26 14:11:13Z rblod $
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 )
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
358      !! * Local declarations
359      INTEGER  ::   ji, jk
360      INTEGER  ::   ijt, iju
361      !!----------------------------------------------------------------------
362      !!  OPA 9.0 , LOCEAN-IPSL (2005)
363      !! $Id: lbclnk.F90 1152 2008-06-26 14:11:13Z rblod $
364      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
365      !!----------------------------------------------------------------------
366
367      IF (PRESENT(cd_mpp)) THEN
368         ! only fill the overlap area and extra allows
369         ! this is in mpp case. In this module, just do nothing
370      ELSE
371     
372      !                                                      ! ===============
373      DO jk = 1, jpk                                         ! Horizontal slab
374         !                                                   ! ===============
375
376         !                                     ! East-West boundaries
377         !                                     ! ====================
378         SELECT CASE ( nperio )
379
380         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west
381            pt3d( 1 ,:,jk) = pt3d(jpim1,:,jk)          ! all points
382            pt3d(jpi,:,jk) = pt3d(  2  ,:,jk)
383
384         CASE DEFAULT                          ! * closed
385            SELECT CASE ( cd_type )
386            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
387               pt3d( 1 ,:,jk) = 0.e0
388               pt3d(jpi,:,jk) = 0.e0
389            CASE ( 'F' )                               ! F-point
390               pt3d(jpi,:,jk) = 0.e0
391            END SELECT
392
393         END SELECT
394
395         !                                     ! North-South boundaries
396         !                                     ! ======================
397         SELECT CASE ( nperio )
398
399         CASE ( 2 )                            ! *  south symmetric
400
401            SELECT CASE ( cd_type )
402            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
403               pt3d(:, 1 ,jk) = pt3d(:,3,jk)
404               pt3d(:,jpj,jk) = 0.e0
405            CASE ( 'V' , 'F' )                         ! V-, F-points
406               pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk)
407               pt3d(:,jpj,jk) = 0.e0
408            END SELECT
409
410         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
411
412            pt3d( 1 ,jpj,jk) = 0.e0
413            pt3d(jpi,jpj,jk) = 0.e0
414
415            SELECT CASE ( cd_type )
416            CASE ( 'T' , 'W' )                         ! T-, W-point
417               DO ji = 2, jpi
418                  ijt = jpi-ji+2
419                  pt3d(ji, 1 ,jk) = 0.e0
420                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
421               END DO
422               DO ji = jpi/2+1, jpi
423                  ijt = jpi-ji+2
424                  pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
425               END DO
426            CASE ( 'U' )                               ! U-point
427               DO ji = 1, jpi-1
428                  iju = jpi-ji+1
429                  pt3d(ji, 1 ,jk) = 0.e0
430                  pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk)
431               END DO
432               DO ji = jpi/2, jpi-1
433                  iju = jpi-ji+1
434                  pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
435               END DO
436            CASE ( 'V' )                               ! V-point
437                  DO ji = 2, jpi
438                     ijt = jpi-ji+2
439                     pt3d(ji,  1  ,jk) = 0.e0
440                     pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk)
441                     pt3d(ji,jpj  ,jk) = psgn * pt3d(ijt,jpj-3,jk)
442                  END DO
443            CASE ( 'F' )                               ! F-point
444                  DO ji = 1, jpi-1
445                     iju = jpi-ji+1
446                     pt3d(ji,jpj-1,jk) = psgn * pt3d(iju,jpj-2,jk)
447                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-3,jk)
448                  END DO
449            END SELECT
450
451         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
452
453            pt3d( 1 ,jpj,jk) = 0.e0
454            pt3d(jpi,jpj,jk) = 0.e0
455
456            SELECT CASE ( cd_type )
457            CASE ( 'T' , 'W' )                         ! T-, W-point
458               DO ji = 1, jpi
459                  ijt = jpi-ji+1
460                  pt3d(ji, 1 ,jk) = 0.e0
461                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk)
462               END DO
463            CASE ( 'U' )                               ! U-point
464                  DO ji = 1, jpi-1
465                     iju = jpi-ji
466                     pt3d(ji, 1 ,jk) = 0.e0
467                     pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk)
468                  END DO
469            CASE ( 'V' )                               ! V-point
470                  DO ji = 1, jpi
471                     ijt = jpi-ji+1
472                     pt3d(ji, 1 ,jk) = 0.e0
473                     pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
474                  END DO
475                  DO ji = jpi/2+1, jpi
476                     ijt = jpi-ji+1
477                     pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
478                  END DO
479            CASE ( 'F' )                               ! F-point
480                  DO ji = 1, jpi-1
481                     iju = jpi-ji
482                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-2,jk)
483                  END DO
484                  DO ji = jpi/2+1, jpi-1
485                     iju = jpi-ji
486                     pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
487                  END DO
488            END SELECT
489
490         CASE DEFAULT                          ! *  closed
491
492            SELECT CASE ( cd_type )
493            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
494               pt3d(:, 1 ,jk) = 0.e0
495               pt3d(:,jpj,jk) = 0.e0
496            CASE ( 'F' )                               ! F-point
497               pt3d(:,jpj,jk) = 0.e0
498            END SELECT
499
500         END SELECT
501         !                                                   ! ===============
502      END DO                                                 !   End of slab
503      !                                                      ! ===============
504   ENDIF
505   END SUBROUTINE lbc_lnk_3d
506
507
508   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp )
509      !!---------------------------------------------------------------------
510      !!                 ***  ROUTINE lbc_lnk_2d  ***
511      !!
512      !! ** Purpose :   set lateral boundary conditions (non mpp case)
513      !!
514      !! ** Method  :
515      !!
516      !! History :
517      !!        !  97-06  (G. Madec)  Original code
518      !!        !  01-05  (E. Durand)  correction
519      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
520      !!----------------------------------------------------------------------
521      !! * Arguments
522      CHARACTER(len=1), INTENT( in ) ::   &
523         cd_type       ! nature of pt2d grid-point
524         !             !   = T , U , V , F or W  gridpoints
525         !             !   = I sea-ice U-V gridpoint (= F ocean grid point with indice shift)
526      REAL(wp), INTENT( in ) ::   &
527         psgn          ! control of the sign change
528         !             !   =-1 , the sign is modified following the type of b.c. used
529         !             !   = 1 , no sign change
530      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
531         pt2d          ! 2D array on which the boundary condition is applied
532      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
533         cd_mpp        ! fill the overlap area only (here do nothing)
534
535      !! * Local declarations
536      INTEGER  ::   ji
537      INTEGER  ::   ijt, iju
538      !!----------------------------------------------------------------------
539      !!  OPA 8.5, LODYC-IPSL (2002)
540      !!----------------------------------------------------------------------
541
542      IF (PRESENT(cd_mpp)) THEN
543         ! only fill the overlap area and extra allows
544         ! this is in mpp case. In this module, just do nothing
545      ELSE     
546     
547      !                                        ! East-West boundaries
548      !                                        ! ====================
549      SELECT CASE ( nperio )
550
551      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
552         pt2d( 1 ,:) = pt2d(jpim1,:)
553         pt2d(jpi,:) = pt2d(  2  ,:)
554
555      CASE DEFAULT                             ! * closed
556         SELECT CASE ( cd_type )
557         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
558            pt2d( 1 ,:) = 0.e0
559            pt2d(jpi,:) = 0.e0
560         CASE ( 'F' )                                  ! F-point, ice U-V point
561            pt2d(jpi,:) = 0.e0 
562         CASE ( 'I' )                                  ! F-point, ice U-V point
563            pt2d( 1 ,:) = 0.e0 
564            pt2d(jpi,:) = 0.e0 
565         END SELECT
566
567      END SELECT
568
569      !                                        ! North-South boundaries
570      !                                        ! ======================
571      SELECT CASE ( nperio )
572
573      CASE ( 2 )                               ! * South symmetric
574
575         SELECT CASE ( cd_type )
576         CASE ( 'T' , 'U' , 'W' )                      ! T-, U-, W-points
577            pt2d(:, 1 ) = pt2d(:,3)
578            pt2d(:,jpj) = 0.e0
579         CASE ( 'V' , 'F' , 'I' )                      ! V-, F-points, ice U-V point
580            pt2d(:, 1 ) = psgn * pt2d(:,2)
581            pt2d(:,jpj) = 0.e0
582         END SELECT
583
584      CASE ( 3 , 4 )                           ! * North fold  T-point pivot
585
586         pt2d( 1 , 1 ) = 0.e0        !!!!!  bug gm ??? !Edmee
587         pt2d( 1 ,jpj) = 0.e0
588         pt2d(jpi,jpj) = 0.e0
589
590         SELECT CASE ( cd_type )
591
592         CASE ( 'T' , 'W' )                            ! T-, W-point
593            DO ji = 2, jpi
594               ijt = jpi-ji+2
595               pt2d(ji, 1 ) = 0.e0
596               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
597            END DO
598            DO ji = jpi/2+1, jpi
599               ijt = jpi-ji+2
600               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
601            END DO
602
603         CASE ( 'U' )                                  ! U-point
604            DO ji = 1, jpi-1
605               iju = jpi-ji+1
606               pt2d(ji, 1 ) = 0.e0
607               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2)
608            END DO
609            DO ji = jpi/2, jpi-1
610               iju = jpi-ji+1
611               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
612            END DO
613
614         CASE ( 'V' )                                  ! V-point
615            DO ji = 2, jpi
616               ijt = jpi-ji+2
617               pt2d(ji, 1   ) = 0.e0
618               pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2)
619               pt2d(ji,jpj  ) = psgn * pt2d(ijt,jpj-3)
620            END DO
621
622         CASE ( 'F' )                                  ! F-point
623            DO ji = 1, jpi-1
624               iju = jpi - ji + 1
625               pt2d(ji,jpj-1) = psgn * pt2d(iju,jpj-2)
626               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-3)
627            END DO
628
629         CASE ( 'I' )                                  ! ice U-V point
630            pt2d(:, 1 ) = 0.e0
631            pt2d(2,jpj) = psgn * pt2d(3,jpj-1)
632            DO ji = 3, jpi
633               iju = jpi - ji + 3
634               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
635            END DO
636
637         END SELECT
638
639      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
640
641         pt2d( 1 , 1 ) = 0.e0           !!bug  ???
642         pt2d( 1 ,jpj) = 0.e0
643         pt2d(jpi,jpj) = 0.e0
644
645         SELECT CASE ( cd_type )
646
647         CASE ( 'T' , 'W' )                            ! T-, W-point
648            DO ji = 1, jpi
649               ijt = jpi-ji+1
650               pt2d(ji, 1 ) = 0.e0
651               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1)
652            END DO
653
654         CASE ( 'U' )                                  ! U-point
655            DO ji = 1, jpi-1
656               iju = jpi-ji
657               pt2d(ji, 1 ) = 0.e0
658               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
659            END DO
660
661         CASE ( 'V' )                                  ! V-point
662            DO ji = 1, jpi
663               ijt = jpi-ji+1
664               pt2d(ji, 1 ) = 0.e0
665               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
666            END DO
667            DO ji = jpi/2+1, jpi
668               ijt = jpi-ji+1
669               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
670            END DO
671
672         CASE ( 'F' )                                  ! F-point
673            DO ji = 1, jpi-1
674               iju = jpi-ji
675               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-2)
676            END DO
677            DO ji = jpi/2+1, jpi-1
678               iju = jpi-ji
679               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
680            END DO
681
682         CASE ( 'I' )                                  ! ice U-V point
683            pt2d( : , 1 ) = 0.e0
684            pt2d( 2 ,jpj) = 0.e0
685            DO ji = 2 , jpim1
686               ijt = jpi - ji + 2
687               pt2d(ji,jpj)= 0.5 * ( pt2d(ji,jpjm1) + psgn * pt2d(ijt,jpjm1) )
688            END DO
689
690         END SELECT
691
692      CASE DEFAULT                             ! * closed
693
694         SELECT CASE ( cd_type )
695         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
696            pt2d(:, 1 ) = 0.e0
697            pt2d(:,jpj) = 0.e0
698         CASE ( 'F' )                                  ! F-point
699            pt2d(:,jpj) = 0.e0
700         CASE ( 'I' )                                  ! ice U-V point
701            pt2d(:, 1 ) = 0.e0
702            pt2d(:,jpj) = 0.e0
703         END SELECT
704
705      END SELECT
706
707      ENDIF
708     
709   END SUBROUTINE lbc_lnk_2d
710
711#endif
712
713   !!======================================================================
714END MODULE lbclnk
Note: See TracBrowser for help on using the repository browser.