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

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

CT : UPDATE001 : First major NEMO update

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