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 branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lbclnk.F90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 13 years ago

set proper svn properties to all files...

  • Property svn:keywords set to Id
File size: 12.8 KB
Line 
1MODULE lbclnk
2   !!======================================================================
3   !!                       ***  MODULE  lbclnk  ***
4   !! Ocean        : lateral boundary conditions
5   !!=====================================================================
6   !!  OPA 9.0 , LOCEAN-IPSL (2005)
7   !! $Id$
8   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
9   !!----------------------------------------------------------------------
10#if   defined key_mpp_mpi   ||   defined key_mpp_shmem
11   !!----------------------------------------------------------------------
12   !!   'key_mpp_mpi'     OR      MPI massively parallel processing library
13   !!   'key_mpp_shmem'         SHMEM massively parallel processing library
14   !!----------------------------------------------------------------------
15   !!----------------------------------------------------------------------
16   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d
17   !!                  routines defined in lib_mpp
18   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e
19   !!                   routinee defined in lib_mpp
20   !!----------------------------------------------------------------------
21   !! * Modules used
22   USE lib_mpp          ! distributed memory computing library
23
24   INTERFACE lbc_lnk
25      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
26   END INTERFACE
27
28   INTERFACE lbc_lnk_e
29      MODULE PROCEDURE mpp_lnk_2d_e
30   END INTERFACE
31
32   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
33   PUBLIC lbc_lnk_e
34   !!----------------------------------------------------------------------
35
36#else
37   !!----------------------------------------------------------------------
38   !!   Default option                              shared memory computing
39   !!----------------------------------------------------------------------
40   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
41   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable
42   !!                  on OPA ocean mesh
43   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable
44   !!                  on OPA ocean mesh
45   !!----------------------------------------------------------------------
46   !! * Modules used
47   USE oce             ! ocean dynamics and tracers   
48   USE dom_oce         ! ocean space and time domain
49   USE in_out_manager  ! I/O manager
50   USE lbcnfd          ! north fold
51
52   IMPLICIT NONE
53   PRIVATE
54
55   INTERFACE lbc_lnk
56      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
57   END INTERFACE
58
59   INTERFACE lbc_lnk_e
60      MODULE PROCEDURE lbc_lnk_2d
61   END INTERFACE
62
63   PUBLIC lbc_lnk       ! ocean/ice  lateral boundary conditions
64   PUBLIC  lbc_lnk_e 
65   !!----------------------------------------------------------------------
66
67CONTAINS
68
69   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
70      !!---------------------------------------------------------------------
71      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
72      !!
73      !! ** Purpose :   set lateral boundary conditions (non mpp case)
74      !!
75      !! ** Method  :
76      !!
77      !! History :
78      !!        !  97-06  (G. Madec)     Original code
79      !!   8.5  !  02-09  (G. Madec)     F90: Free form and module
80      !!        !  09-03  (R. Benshila)  External north fold treatment 
81      !!----------------------------------------------------------------------
82      !! * Arguments
83      CHARACTER(len=1), INTENT( in ) ::   &
84         cd_type1, cd_type2       ! nature of pt3d grid-points
85      !             !   = T ,  U , V , F or W  gridpoints
86      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
87         pt3d1, pt3d2          ! 3D array on which the boundary condition is applied
88      REAL(wp), INTENT( in ) ::   &
89         psgn          ! control of the sign change
90      !             !   =-1 , the sign is changed if north fold boundary
91      !             !   = 1 , no sign change
92      !             !   = 0 , no sign change and > 0 required (use the inner
93      !             !         row/column if closed boundary)
94
95      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
96      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
97
98   END SUBROUTINE lbc_lnk_3d_gather
99
100
101   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
102      !!---------------------------------------------------------------------
103      !!                  ***  ROUTINE lbc_lnk_3d  ***
104      !!
105      !! ** Purpose :   set lateral boundary conditions (non mpp case)
106      !!
107      !! ** Method  :
108      !!
109      !! History :
110      !!        !  97-06  (G. Madec)  Original code
111      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
112      !!        !  09-03  (R. Benshila)  External north fold treatment 
113      !!----------------------------------------------------------------------
114      !! * Arguments
115      CHARACTER(len=1), INTENT( in ) ::   &
116         cd_type       ! nature of pt3d grid-points
117      !             !   = T ,  U , V , F or W  gridpoints
118      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
119         pt3d          ! 3D array on which the boundary condition is applied
120      REAL(wp), INTENT( in ) ::   &
121         psgn          ! control of the sign change
122      !             !   =-1 , the sign is changed if north fold boundary
123      !             !   = 1 , no sign change
124      !             !   = 0 , no sign change and > 0 required (use the inner
125      !             !         row/column if closed boundary)
126      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
127         cd_mpp        ! fill the overlap area only (here do nothing)
128      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
129
130      !! * Local declarations
131      REAL(wp) ::   zland
132
133      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
134         zland = pval
135      ELSE
136         zland = 0.e0
137      ENDIF
138
139
140      IF( PRESENT( cd_mpp ) ) THEN
141         ! only fill the overlap area and extra allows
142         ! this is in mpp case. In this module, just do nothing
143      ELSE
144
145         !                                     !  East-West boundaries
146         !                                     ! ======================
147         SELECT CASE ( nperio )
148         !
149         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
150            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
151            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
152            !
153         CASE DEFAULT                             !**  East closed  --  West closed
154            SELECT CASE ( cd_type )
155            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
156               pt3d( 1 ,:,:) = zland
157               pt3d(jpi,:,:) = zland
158            CASE ( 'F' )                               ! F-point
159               pt3d(jpi,:,:) = zland
160            END SELECT
161            !
162         END SELECT
163
164         !                                     ! North-South boundaries
165         !                                     ! ======================
166         SELECT CASE ( nperio )
167         !
168         CASE ( 2 )                               !**  South symmetric  --  North closed
169            SELECT CASE ( cd_type )
170            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
171               pt3d(:, 1 ,:) = pt3d(:,3,:)
172               pt3d(:,jpj,:) = zland
173            CASE ( 'V' , 'F' )                         ! V-, F-points
174               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
175               pt3d(:,jpj,:) = zland
176            END SELECT
177            !
178         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
179            SELECT CASE ( cd_type )                    ! South : closed
180            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
181               pt3d(:, 1 ,:) = zland
182            END SELECT
183            !                                          ! North fold
184            pt3d( 1 ,jpj,:) = zland
185            pt3d(jpi,jpj,:) = zland
186            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
187            !
188         CASE DEFAULT                             !**  North closed  --  South closed
189            SELECT CASE ( cd_type )
190            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
191               pt3d(:, 1 ,:) = zland
192               pt3d(:,jpj,:) = zland
193            CASE ( 'F' )                               ! F-point
194               pt3d(:,jpj,:) = zland
195            END SELECT
196            !
197         END SELECT
198
199      ENDIF
200
201   END SUBROUTINE lbc_lnk_3d
202
203
204   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
205      !!---------------------------------------------------------------------
206      !!                 ***  ROUTINE lbc_lnk_2d  ***
207      !!
208      !! ** Purpose :   set lateral boundary conditions (non mpp case)
209      !!
210      !! ** Method  :
211      !!
212      !! History :
213      !!        !  97-06  (G. Madec)  Original code
214      !!        !  01-05  (E. Durand)  correction
215      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
216      !!        !  09-03  (R. Benshila)  External north fold treatment 
217      !!----------------------------------------------------------------------
218      !! * Arguments
219      CHARACTER(len=1), INTENT( in ) ::   &
220         cd_type       ! nature of pt2d grid-point
221         !             !   = T , U , V , F or W  gridpoints
222         !             !   = I sea-ice U-V gridpoint (= F ocean grid point with indice shift)
223      REAL(wp), INTENT( in ) ::   &
224         psgn          ! control of the sign change
225         !             !   =-1 , the sign is modified following the type of b.c. used
226         !             !   = 1 , no sign change
227      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
228         pt2d          ! 2D array on which the boundary condition is applied
229      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
230         cd_mpp        ! fill the overlap area only (here do nothing)
231      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
232
233      !! * Local declarations
234      REAL(wp) ::   zland
235
236      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
237         zland = pval
238      ELSE
239         zland = 0.e0
240      ENDIF
241
242      IF (PRESENT(cd_mpp)) THEN
243         ! only fill the overlap area and extra allows
244         ! this is in mpp case. In this module, just do nothing
245      ELSE     
246     
247         !                                     ! East-West boundaries
248         !                                     ! ====================
249         SELECT CASE ( nperio )
250         !
251         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
252            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
253            pt2d(jpi,:) = pt2d(  2  ,:)
254            !
255         CASE DEFAULT                             !** East closed  --  West closed
256            SELECT CASE ( cd_type )
257            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
258               pt2d( 1 ,:) = zland
259               pt2d(jpi,:) = zland
260            CASE ( 'F' )                              ! F-point
261               pt2d(jpi,:) = zland
262            END SELECT
263            !
264         END SELECT
265 
266         !                                     ! North-South boundaries
267         !                                     ! ======================
268         SELECT CASE ( nperio )
269         !
270         CASE ( 2 )                               !**  South symmetric  --  North closed
271            SELECT CASE ( cd_type )
272            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
273               pt2d(:, 1 ) = pt2d(:,3)
274               pt2d(:,jpj) = zland
275            CASE ( 'V' , 'F' )                         ! V-, F-points
276               pt2d(:, 1 ) = psgn * pt2d(:,2)
277               pt2d(:,jpj) = zland
278            END SELECT
279            !
280         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
281            SELECT CASE ( cd_type )                    ! South : closed
282            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
283               pt2d(:, 1 ) = zland
284            END SELECT
285            !                                          ! North fold
286            pt2d( 1 ,1  ) = zland 
287            pt2d( 1 ,jpj) = zland 
288            pt2d(jpi,jpj) = zland
289            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
290            !
291         CASE DEFAULT                             !**  North closed  --  South closed
292            SELECT CASE ( cd_type )
293            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
294               pt2d(:, 1 ) = zland
295               pt2d(:,jpj) = zland
296            CASE ( 'F' )                               ! F-point
297               pt2d(:,jpj) = zland
298            END SELECT
299            !
300         END SELECT
301
302      ENDIF
303     
304   END SUBROUTINE lbc_lnk_2d
305
306#endif
307
308   !!======================================================================
309END MODULE lbclnk
Note: See TracBrowser for help on using the repository browser.