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 @ 247

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 16.0 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   !!----------------------------------------------------------------------
15   !! * Modules used
16   USE lib_mpp          ! distributed memory computing library
17
18   INTERFACE lbc_lnk
19      MODULE PROCEDURE mpp_lnk_3d, mpp_lnk_2d
20   END INTERFACE
21
22   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
23   !!----------------------------------------------------------------------
24
25#else
26   !!----------------------------------------------------------------------
27   !!   Default option                              shared memory computing
28   !!----------------------------------------------------------------------
29   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
30   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable
31   !!                  on OPA ocean mesh
32   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable
33   !!                  on OPA ocean mesh
34   !!----------------------------------------------------------------------
35   !! * Modules used
36   USE oce             ! ocean dynamics and tracers   
37   USE dom_oce         ! ocean space and time domain
38   USE in_out_manager  ! I/O manager
39
40   IMPLICIT NONE
41   PRIVATE
42
43   INTERFACE lbc_lnk
44      MODULE PROCEDURE lbc_lnk_3d, lbc_lnk_2d
45   END INTERFACE
46
47   PUBLIC lbc_lnk       ! ocean/ice  lateral boundary conditions
48   !!----------------------------------------------------------------------
49
50CONTAINS
51
52   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn )
53      !!---------------------------------------------------------------------
54      !!                  ***  ROUTINE lbc_lnk_3d  ***
55      !!
56      !! ** Purpose :   set lateral boundary conditions (non mpp case)
57      !!
58      !! ** Method  :
59      !!
60      !! History :
61      !!        !  97-06  (G. Madec)  Original code
62      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
63      !!----------------------------------------------------------------------
64      !! * Arguments
65      CHARACTER(len=1), INTENT( in ) ::   &
66         cd_type       ! nature of pt3d grid-points
67         !             !   = T ,  U , V , F or W  gridpoints
68      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
69         pt3d          ! 3D array on which the boundary condition is applied
70      REAL(wp), INTENT( in ) ::   &
71         psgn          ! control of the sign change
72         !             !   =-1 , the sign is changed if north fold boundary
73         !             !   = 1 , no sign change
74         !             !   = 0 , no sign change and > 0 required (use the inner
75         !             !         row/column if closed boundary)
76
77      !! * Local declarations
78      INTEGER  ::   ji, jk
79      INTEGER  ::   ijt, iju
80      !!----------------------------------------------------------------------
81      !!  OPA 9.0 , LOCEAN-IPSL (2005)
82      !! $Header$
83      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
84      !!----------------------------------------------------------------------
85     
86      !                                                      ! ===============
87      DO jk = 1, jpk                                         ! Horizontal slab
88         !                                                   ! ===============
89
90         !                                     ! East-West boundaries
91         !                                     ! ====================
92         SELECT CASE ( nperio )
93
94         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west
95            pt3d( 1 ,:,jk) = pt3d(jpim1,:,jk)          ! all points
96            pt3d(jpi,:,jk) = pt3d(  2  ,:,jk)
97
98         CASE DEFAULT                          ! * closed
99            SELECT CASE ( cd_type )
100            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
101               pt3d( 1 ,:,jk) = 0.e0
102               pt3d(jpi,:,jk) = 0.e0
103            CASE ( 'F' )                               ! F-point
104               pt3d(jpi,:,jk) = 0.e0
105            END SELECT
106
107         END SELECT
108
109         !                                     ! North-South boundaries
110         !                                     ! ======================
111         SELECT CASE ( nperio )
112
113         CASE ( 2 )                            ! *  south symmetric
114
115            SELECT CASE ( cd_type )
116            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
117               pt3d(:, 1 ,jk) = pt3d(:,3,jk)
118               pt3d(:,jpj,jk) = 0.e0
119            CASE ( 'V' , 'F' )                         ! V-, F-points
120               pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk)
121               pt3d(:,jpj,jk) = 0.e0
122            END SELECT
123
124         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
125
126            pt3d( 1 ,jpj,jk) = 0.e0
127            pt3d(jpi,jpj,jk) = 0.e0
128
129            SELECT CASE ( cd_type )
130            CASE ( 'T' , 'W' )                         ! T-, W-point
131               DO ji = 2, jpi
132                  ijt = jpi-ji+2
133                  pt3d(ji, 1 ,jk) = 0.e0
134                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
135               END DO
136               DO ji = jpi/2+1, jpi
137                  ijt = jpi-ji+2
138                  pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
139               END DO
140            CASE ( 'U' )                               ! U-point
141               DO ji = 1, jpi-1
142                  iju = jpi-ji+1
143                  pt3d(ji, 1 ,jk) = 0.e0
144                  pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk)
145               END DO
146               DO ji = jpi/2, jpi-1
147                  iju = jpi-ji+1
148                  pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
149               END DO
150            CASE ( 'V' )                               ! V-point
151                  DO ji = 2, jpi
152                     ijt = jpi-ji+2
153                     pt3d(ji,  1  ,jk) = 0.e0
154                     pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk)
155                     pt3d(ji,jpj  ,jk) = psgn * pt3d(ijt,jpj-3,jk)
156                  END DO
157            CASE ( 'F' )                               ! F-point
158                  DO ji = 1, jpi-1
159                     iju = jpi-ji+1
160                     pt3d(ji,jpj-1,jk) = psgn * pt3d(iju,jpj-2,jk)
161                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-3,jk)
162                  END DO
163            END SELECT
164
165         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
166
167            pt3d( 1 ,jpj,jk) = 0.e0
168            pt3d(jpi,jpj,jk) = 0.e0
169
170            SELECT CASE ( cd_type )
171            CASE ( 'T' , 'W' )                         ! T-, W-point
172               DO ji = 1, jpi
173                  ijt = jpi-ji+1
174                  pt3d(ji, 1 ,jk) = 0.e0
175                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk)
176               END DO
177            CASE ( 'U' )                               ! U-point
178                  DO ji = 1, jpi-1
179                     iju = jpi-ji
180                     pt3d(ji, 1 ,jk) = 0.e0
181                     pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk)
182                  END DO
183            CASE ( 'V' )                               ! V-point
184                  DO ji = 1, jpi
185                     ijt = jpi-ji+1
186                     pt3d(ji, 1 ,jk) = 0.e0
187                     pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
188                  END DO
189                  DO ji = jpi/2+1, jpi
190                     ijt = jpi-ji+1
191                     pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
192                  END DO
193            CASE ( 'F' )                               ! F-point
194                  DO ji = 1, jpi-1
195                     iju = jpi-ji
196                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-2,jk)
197                  END DO
198                  DO ji = jpi/2+1, jpi-1
199                     iju = jpi-ji
200                     pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
201                  END DO
202            END SELECT
203
204         CASE DEFAULT                          ! *  closed
205
206            SELECT CASE ( cd_type )
207            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
208               pt3d(:, 1 ,jk) = 0.e0
209               pt3d(:,jpj,jk) = 0.e0
210            CASE ( 'F' )                               ! F-point
211               pt3d(:,jpj,jk) = 0.e0
212            END SELECT
213
214         END SELECT
215         !                                                   ! ===============
216      END DO                                                 !   End of slab
217      !                                                      ! ===============
218   END SUBROUTINE lbc_lnk_3d
219
220
221   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn )
222      !!---------------------------------------------------------------------
223      !!                 ***  ROUTINE lbc_lnk_2d  ***
224      !!
225      !! ** Purpose :   set lateral boundary conditions (non mpp case)
226      !!
227      !! ** Method  :
228      !!
229      !! History :
230      !!        !  97-06  (G. Madec)  Original code
231      !!        !  01-05  (E. Durand)  correction
232      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
233      !!----------------------------------------------------------------------
234      !! * Arguments
235      CHARACTER(len=1), INTENT( in ) ::   &
236         cd_type       ! nature of pt2d grid-point
237         !             !   = T , U , V , F or W  gridpoints
238         !             !   = I sea-ice U-V gridpoint (= F ocean grid point with indice shift)
239      REAL(wp), INTENT( in ) ::   &
240         psgn          ! control of the sign change
241         !             !   =-1 , the sign is modified following the type of b.c. used
242         !             !   = 1 , no sign change
243      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
244         pt2d          ! 2D array on which the boundary condition is applied
245
246      !! * Local declarations
247      INTEGER  ::   ji
248      INTEGER  ::   ijt, iju
249      !!----------------------------------------------------------------------
250      !!  OPA 8.5, LODYC-IPSL (2002)
251      !!----------------------------------------------------------------------
252     
253     
254      !                                        ! East-West boundaries
255      !                                        ! ====================
256      SELECT CASE ( nperio )
257
258      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
259         pt2d( 1 ,:) = pt2d(jpim1,:)
260         pt2d(jpi,:) = pt2d(  2  ,:)
261
262      CASE DEFAULT                             ! * closed
263         SELECT CASE ( cd_type )
264         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
265            pt2d( 1 ,:) = 0.e0
266            pt2d(jpi,:) = 0.e0
267         CASE ( 'F' )                                  ! F-point, ice U-V point
268            pt2d(jpi,:) = 0.e0 
269         CASE ( 'I' )                                  ! F-point, ice U-V point
270            pt2d( 1 ,:) = 0.e0 
271            pt2d(jpi,:) = 0.e0 
272         END SELECT
273
274      END SELECT
275
276      !                                        ! North-South boundaries
277      !                                        ! ======================
278      SELECT CASE ( nperio )
279
280      CASE ( 2 )                               ! * South symmetric
281
282         SELECT CASE ( cd_type )
283         CASE ( 'T' , 'U' , 'W' )                      ! T-, U-, W-points
284            pt2d(:, 1 ) = pt2d(:,3)
285            pt2d(:,jpj) = 0.e0
286         CASE ( 'V' , 'F' , 'I' )                      ! V-, F-points, ice U-V point
287            pt2d(:, 1 ) = psgn * pt2d(:,2)
288            pt2d(:,jpj) = 0.e0
289         END SELECT
290
291      CASE ( 3 , 4 )                           ! * North fold  T-point pivot
292
293         pt2d( 1 , 1 ) = 0.e0        !!!!!  bug gm ??? !Edmee
294         pt2d( 1 ,jpj) = 0.e0
295         pt2d(jpi,jpj) = 0.e0
296
297         SELECT CASE ( cd_type )
298
299         CASE ( 'T' , 'W' )                            ! T-, W-point
300            DO ji = 2, jpi
301               ijt = jpi-ji+2
302               pt2d(ji, 1 ) = 0.e0
303               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
304            END DO
305            DO ji = jpi/2+1, jpi
306               ijt = jpi-ji+2
307               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
308            END DO
309
310         CASE ( 'U' )                                  ! U-point
311            DO ji = 1, jpi-1
312               iju = jpi-ji+1
313               pt2d(ji, 1 ) = 0.e0
314               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2)
315            END DO
316            DO ji = jpi/2, jpi-1
317               iju = jpi-ji+1
318               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
319            END DO
320
321         CASE ( 'V' )                                  ! V-point
322            DO ji = 2, jpi
323               ijt = jpi-ji+2
324               pt2d(ji, 1   ) = 0.e0
325               pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2)
326               pt2d(ji,jpj  ) = psgn * pt2d(ijt,jpj-3)
327            END DO
328
329         CASE ( 'F' )                                  ! F-point
330            DO ji = 1, jpi-1
331               iju = jpi - ji + 1
332               pt2d(ji,jpj-1) = psgn * pt2d(iju,jpj-2)
333               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-3)
334            END DO
335
336         CASE ( 'I' )                                  ! ice U-V point
337            pt2d(2,jpj) = psgn * pt2d(3,jpj-1)
338            DO ji = 3, jpi
339               iju = jpi - ji + 3
340               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
341            END DO
342
343         END SELECT
344
345      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
346
347         pt2d( 1 , 1 ) = 0.e0           !!bug  ???
348         pt2d( 1 ,jpj) = 0.e0
349         pt2d(jpi,jpj) = 0.e0
350
351         SELECT CASE ( cd_type )
352
353         CASE ( 'T' , 'W' )                            ! T-, W-point
354            DO ji = 1, jpi
355               ijt = jpi-ji+1
356               pt2d(ji, 1 ) = 0.e0
357               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1)
358            END DO
359
360         CASE ( 'U' )                                  ! U-point
361            DO ji = 1, jpi-1
362               iju = jpi-ji
363               pt2d(ji, 1 ) = 0.e0
364               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
365            END DO
366
367         CASE ( 'V' )                                  ! V-point
368            DO ji = 1, jpi
369               ijt = jpi-ji+1
370               pt2d(ji, 1 ) = 0.e0
371               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
372            END DO
373            DO ji = jpi/2+1, jpi
374               ijt = jpi-ji+1
375               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
376            END DO
377
378         CASE ( 'F' )                                  ! F-point
379            DO ji = 1, jpi-1
380               iju = jpi-ji
381               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-2)
382            END DO
383            DO ji = jpi/2+1, jpi-1
384               iju = jpi-ji
385               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
386            END DO
387
388         CASE ( 'I' )                                  ! ice U-V point
389            pt2d( 2 ,jpj) = 0.e0
390            DO ji = 2 , jpim1
391               ijt = jpi - ji + 2
392               pt2d(ji,jpj)= 0.5 * ( pt2d(ji,jpjm1) + psgn * pt2d(ijt,jpjm1) )
393            END DO
394
395         END SELECT
396
397      CASE DEFAULT                             ! * closed
398
399         SELECT CASE ( cd_type )
400         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
401            pt2d(:, 1 ) = 0.e0
402            pt2d(:,jpj) = 0.e0
403         CASE ( 'F' )                                  ! F-point
404            pt2d(:,jpj) = 0.e0
405         CASE ( 'I' )                                  ! ice U-V point
406            pt2d(:, 1 ) = 0.e0
407            pt2d(:,jpj) = 0.e0
408         END SELECT
409
410      END SELECT
411
412   END SUBROUTINE lbc_lnk_2d
413
414#endif
415
416   !!======================================================================
417END MODULE lbclnk
Note: See TracBrowser for help on using the repository browser.