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

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

CT : UPDATE057 : # General syntax, alignement, comments corrections

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