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/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

Context Navigation

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 4409

Last change on this file since 4409 was 4409, checked in by trackstand2, 10 years ago
Changes to allow jpk to be modified to deepest level within a subdomain. jpkorig holds original value.
Property svn:keywords set to `Id`
File size: 14.0 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: