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

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision

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