Context Navigation

lbc.f90 @ 13369

Last change on this file since 13369 was 13369, checked in by jpaul, 4 years ago
update: cf changelog inside documentation
File size: 32.5 KB

Line
1	!----------------------------------------------------------------------
2	! NEMO system team, System and Interface for oceanic RElocable Nesting
3	!----------------------------------------------------------------------
4	!
5	! DESCRIPTION:
6	!> @brief
7	!> This module groups lateral boundary conditions subroutine.
8	!>
9	!> @details
10	!>
11	!> @warning keep only non mpp case
12	!>
13	!> @author
14	!> G. Madec
15	!>
16	!> @date June, 1997 - Original code
17	!> @date September, 2002
18	!> - F90: Free form and module
19	!> @date Marsh, 2009
20	!> - R. Benshila : External north fold treatment
21	!> @date December, 2012
22	!> - S.Mocavero, I. Epicoco : Add 'lbc_bdy_lnk' and lbc_obc_lnk' routine to optimize the BDY/OBC communications
23	!> @date December, 2012
24	!> - R. Bourdalle-Badie and G. Reffray : add a C1D case
25	!> @date January, 2015
26	!> - J.Paul : rewrite with SIREN coding rules
27	!> @date Marsh, 2015
28	!> - J.Paul : add hide subroutine
29	!>
30	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
31	!----------------------------------------------------------------------
32	MODULE lbc
33
34	USE kind ! F90 kind parameter
35	! NOTE_avoid_public_variables_if_possible
36
37	! function and subroutine
38	PUBLIC :: lbc_lnk
39	PUBLIC :: lbc_nfd
40	PUBLIC :: lbc_hide
41
42	PRIVATE :: lbc__lnk_3d
43	PRIVATE :: lbc__lnk_2d
44	PRIVATE :: lbc__nfd_3d
45	PRIVATE :: lbc__nfd_2d
46	PRIVATE :: lbc__hide_lnk_2d
47	PRIVATE :: lbc__hide_nfd
48	PRIVATE :: lbc__hide_nfd_2d
49
50	INTERFACE lbc_lnk
51	MODULE PROCEDURE lbc__lnk_3d
52	MODULE PROCEDURE lbc__lnk_2d
53	END INTERFACE
54
55	INTERFACE lbc_nfd
56	MODULE PROCEDURE lbc__nfd_3d
57	MODULE PROCEDURE lbc__nfd_2d
58	END INTERFACE
59
60	INTERFACE lbc_hide
61	MODULE PROCEDURE lbc__hide_lnk_2d
62	END INTERFACE
63
64	INTERFACE lbc__hide_nfd
65	MODULE PROCEDURE lbc__hide_nfd_2d
66	END INTERFACE
67
68	CONTAINS
69	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
70	SUBROUTINE lbc__lnk_3d(dd_array, cd_type, id_perio, dd_psgn, dd_fill)
71	!-------------------------------------------------------------------
72	!> @brief This subroutine set lateral boundary conditions on a 3D array (non mpp case)
73	!>
74	!> @details
75	!> dd_psign = -1 : change the sign across the north fold
76	!> = 1 : no change of the sign across the north fold
77	!> = 0 : no change of the sign across the north fold and
78	!> strict positivity preserved: use inner row/column
79	!> for closed boundaries.
80	!> @author J.Paul
81	!> - January, 2015- rewrite with SIREN coding rules
82	!>
83	!> @param[inout] dd_array 3D array
84	!> @param[in] cd_type point grid
85	!> @param[in] id_perio NEMO periodicity of the grid
86	!> @param[in] dd_psgn
87	!> @param[in] dd_fill fillValue
88	!-------------------------------------------------------------------
89
90	IMPLICIT NONE
91
92	! Argument
93	REAL(dp), DIMENSION(:,:,:), INTENT(INOUT) :: dd_array
94	CHARACTER(LEN=*) , INTENT(IN ) :: cd_type
95	INTEGER(i4) , INTENT(IN ) :: id_perio
96	REAL(dp), INTENT(IN ) :: dd_psgn
97	REAL(dp), INTENT(IN ), OPTIONAL :: dd_fill
98
99	! local variable
100	REAL(dp) :: dl_fill
101
102	INTEGER(i4) :: il_jpi
103	INTEGER(i4) :: il_jpj
104	INTEGER(i4) :: il_jpim1
105	!----------------------------------------------------------------
106	IF( PRESENT( dd_fill ) ) THEN ; dl_fill = dd_fill ! set FillValue (zero by default)
107	ELSE ; dl_fill = 0._dp
108	ENDIF
109
110	il_jpi=SIZE(dd_array(:,:,:),DIM=1)
111	il_jpj=SIZE(dd_array(:,:,:),DIM=2)
112
113	il_jpim1=il_jpi-1
114	!
115	! ! East-West boundaries
116	! ! ====================
117	SELECT CASE ( id_perio )
118	!
119	CASE ( 1 , 4 , 6 ) !** cyclic east-west
120	dd_array( 1 ,:,:) = dd_array(il_jpim1,:,:) ! all points
121	dd_array(il_jpi,:,:) = dd_array( 2 ,:,:)
122	!
123	CASE DEFAULT !** East closed -- West closed
124	SELECT CASE ( TRIM(cd_type) )
125	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
126	dd_array( 1 ,:,:) = dl_fill
127	dd_array(il_jpi,:,:) = dl_fill
128	CASE ( 'F' ) ! F-point
129	dd_array(il_jpi,:,:) = dl_fill
130	END SELECT
131	!
132	END SELECT
133	!
134	! ! North-South boundaries
135	! ! ======================
136	SELECT CASE ( id_perio )
137	!
138	CASE ( 2 ) !** South symmetric -- North closed
139	SELECT CASE ( TRIM(cd_type) )
140	CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points
141	dd_array(:, 1 ,:) = dd_array(:,3,:)
142	dd_array(:,il_jpj,:) = dl_fill
143	CASE ( 'V' , 'F' ) ! V-, F-points
144	dd_array(:, 1 ,:) = dd_psgn * dd_array(:,2,:)
145	dd_array(:,il_jpj,:) = dl_fill
146	END SELECT
147	!
148	CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed
149	SELECT CASE ( TRIM(cd_type) ) ! South : closed
150	CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point
151	dd_array(:, 1 ,:) = dl_fill
152	END SELECT
153	! ! North fold
154	CALL lbc_nfd( dd_array(:,:,:), cd_type, id_perio, dd_psgn )
155	!
156	CASE DEFAULT !** North closed -- South closed
157	SELECT CASE ( cd_type )
158	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
159	dd_array(:, 1 ,:) = dl_fill
160	dd_array(:,il_jpj,:) = dl_fill
161	CASE ( 'F' ) ! F-point
162	dd_array(:,il_jpj,:) = dl_fill
163	END SELECT
164	!
165	END SELECT
166
167	END SUBROUTINE lbc__lnk_3d
168	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
169	SUBROUTINE lbc__lnk_2d(dd_array, cd_type, id_perio, dd_psgn, dd_fill)
170	!-------------------------------------------------------------------
171	!> @brief This subroutine set lateral boundary conditions on a 2D array (non mpp case)
172	!>
173	!> @details
174	!> dd_psign = -1 : change the sign across the north fold
175	!> = 1 : no change of the sign across the north fold
176	!> = 0 : no change of the sign across the north fold and
177	!> strict positivity preserved: use inner row/column
178	!> for closed boundaries.
179	!> @author J.Paul
180	!> - January, 2015- rewrite with SIREN coding rules
181	!>
182	!> @param[inout] dd_array 2D array
183	!> @param[in] cd_type point grid
184	!> @param[in] id_perio NEMO periodicity of the grid
185	!> @param[in] dd_psgn
186	!> @param[in] dd_fill fillValue
187	!-------------------------------------------------------------------
188
189	IMPLICIT NONE
190
191	! Argument
192	REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
193	CHARACTER(LEN=*) , INTENT(IN ) :: cd_type
194	INTEGER(i4) , INTENT(IN ) :: id_perio
195	REAL(dp) , INTENT(IN ) :: dd_psgn
196	REAL(dp) , INTENT(IN ), OPTIONAL :: dd_fill
197
198	! local variable
199	REAL(dp) :: dl_fill
200
201	INTEGER(i4) :: il_jpi
202	INTEGER(i4) :: il_jpj
203	INTEGER(i4) :: il_jpim1
204	!----------------------------------------------------------------
205	IF( PRESENT( dd_fill ) ) THEN ; dl_fill = dd_fill ! set FillValue (zero by default)
206	ELSE ; dl_fill = 0._dp
207	ENDIF
208
209	il_jpi=SIZE(dd_array(:,:),DIM=1)
210	il_jpj=SIZE(dd_array(:,:),DIM=2)
211
212	il_jpim1=il_jpi-1
213
214	!
215	! ! East-West boundaries
216	! ! ====================
217	SELECT CASE ( id_perio )
218	!
219	CASE ( 1 , 4 , 6 ) !** cyclic east-west
220	dd_array( 1 ,:) = dd_array(il_jpim1,:) ! all points
221	dd_array(il_jpi,:) = dd_array( 2 ,:)
222	!
223	CASE DEFAULT !** East closed -- West closed
224	SELECT CASE ( TRIM(cd_type) )
225	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
226	dd_array( 1 ,:) = dl_fill
227	dd_array(il_jpi,:) = dl_fill
228	CASE ( 'F' ) ! F-point
229	dd_array(il_jpi,:) = dl_fill
230	END SELECT
231	!
232	END SELECT
233	!
234	! ! North-South boundaries
235	! ! ======================
236	SELECT CASE ( id_perio )
237	!
238	CASE ( 2 ) !** South symmetric -- North closed
239	SELECT CASE ( TRIM(cd_type) )
240	CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points
241	dd_array(:, 1 ) = dd_array(:,3)
242	dd_array(:,il_jpj) = dl_fill
243	CASE ( 'V' , 'F' ) ! V-, F-points
244	dd_array(:, 1 ) = dd_psgn * dd_array(:,2)
245	dd_array(:,il_jpj) = dl_fill
246	END SELECT
247	!
248	CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed
249	SELECT CASE ( TRIM(cd_type) ) ! South : closed
250	CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point
251	dd_array(:, 1 ) = dl_fill
252	END SELECT
253	! ! North fold
254	CALL lbc_nfd( dd_array(:,:), cd_type, id_perio, dd_psgn )
255	!
256	CASE DEFAULT !** North closed -- South closed
257	SELECT CASE ( TRIM(cd_type) )
258	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
259	dd_array(:, 1 ) = dl_fill
260	dd_array(:,il_jpj) = dl_fill
261	CASE ( 'F' ) ! F-point
262	dd_array(:,il_jpj) = dl_fill
263	END SELECT
264	!
265	END SELECT
266
267	END SUBROUTINE lbc__lnk_2d
268	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
269	SUBROUTINE lbc__nfd_3d(dd_array, cd_type, id_perio, dd_psgn)
270	!-------------------------------------------------------------------
271	!> @brief This subroutine manage 3D lateral boundary condition :
272	!> North fold treatment without processor exchanges.
273	!>
274	!> @warning keep only non mpp case
275	!>
276	!> @author J.Paul
277	!> - January, 2015- rewrite with SIREN coding rules
278	!>
279	!> @param[inout] dd_array 3D array
280	!> @param[in] cd_type point grid
281	!> @param[in] id_perio NEMO periodicity of the grid
282	!> @param[in] dd_psgn
283	!-------------------------------------------------------------------
284
285	IMPLICIT NONE
286
287	! Argument
288	REAL(dp), DIMENSION(:,:,:), INTENT(INOUT) :: dd_array
289	CHARACTER(LEN=*) , INTENT(IN ) :: cd_type
290	INTEGER(i4) , INTENT(IN ) :: id_perio
291	REAL(dp) , INTENT(IN ) :: dd_psgn
292
293	! local variable
294	INTEGER(i4) :: il_jpi
295	INTEGER(i4) :: il_jpj
296	INTEGER(i4) :: il_jpk
297	INTEGER(i4) :: il_jpim1
298	INTEGER(i4) :: il_jpjm1
299
300	INTEGER(i4) :: ijt
301	INTEGER(i4) :: iju
302
303	! loop indices
304	INTEGER(i4) :: ji
305	INTEGER(i4) :: jk
306	!----------------------------------------------------------------
307
308	il_jpi=SIZE(dd_array(:,:,:),DIM=1)
309	il_jpj=SIZE(dd_array(:,:,:),DIM=2)
310	il_jpk=SIZE(dd_array(:,:,:),DIM=3)
311
312	il_jpim1=il_jpi-1
313	il_jpjm1=il_jpj-1
314
315	DO jk = 1, il_jpk
316	!
317	SELECT CASE ( id_perio )
318	!
319	CASE ( 3 , 4 ) ! * North fold T-point pivot
320	!
321	SELECT CASE ( TRIM(cd_type) )
322	CASE ( 'T' , 'W' ) ! T-, W-point
323	DO ji = 2, il_jpi
324	ijt = il_jpi-ji+2
325	dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(ijt,il_jpj-2,jk)
326	END DO
327	dd_array(1,il_jpj,jk) = dd_psgn * dd_array(3,il_jpj-2,jk)
328	DO ji = il_jpi/2+1, il_jpi
329	ijt = il_jpi-ji+2
330	dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(ijt,il_jpjm1,jk)
331	END DO
332	CASE ( 'U' ) ! U-point
333	DO ji = 1, il_jpi-1
334	iju = il_jpi-ji+1
335	dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(iju,il_jpj-2,jk)
336	END DO
337	dd_array( 1 ,il_jpj,jk) = dd_psgn * dd_array( 2 ,il_jpj-2,jk)
338	dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(il_jpi-1,il_jpj-2,jk)
339	DO ji = il_jpi/2, il_jpi-1
340	iju = il_jpi-ji+1
341	dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(iju,il_jpjm1,jk)
342	END DO
343	CASE ( 'V' ) ! V-point
344	DO ji = 2, il_jpi
345	ijt = il_jpi-ji+2
346	dd_array(ji,il_jpj-1,jk) = dd_psgn * dd_array(ijt,il_jpj-2,jk)
347	dd_array(ji,il_jpj ,jk) = dd_psgn * dd_array(ijt,il_jpj-3,jk)
348	END DO
349	dd_array(1,il_jpj,jk) = dd_psgn * dd_array(3,il_jpj-3,jk)
350	CASE ( 'F' ) ! F-point
351	DO ji = 1, il_jpi-1
352	iju = il_jpi-ji+1
353	dd_array(ji,il_jpj-1,jk) = dd_psgn * dd_array(iju,il_jpj-2,jk)
354	dd_array(ji,il_jpj ,jk) = dd_psgn * dd_array(iju,il_jpj-3,jk)
355	END DO
356	dd_array( 1 ,il_jpj,jk) = dd_psgn * dd_array( 2 ,il_jpj-3,jk)
357	dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(il_jpi-1,il_jpj-3,jk)
358	END SELECT
359	!
360	CASE ( 5 , 6 ) ! * North fold F-point pivot
361	!
362	SELECT CASE ( TRIM(cd_type) )
363	CASE ( 'T' , 'W' ) ! T-, W-point
364	DO ji = 1, il_jpi
365	ijt = il_jpi-ji+1
366	dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(ijt,il_jpj-1,jk)
367	END DO
368	CASE ( 'U' ) ! U-point
369	DO ji = 1, il_jpi-1
370	iju = il_jpi-ji
371	dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(iju,il_jpj-1,jk)
372	END DO
373	dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(1,il_jpj-1,jk)
374	CASE ( 'V' ) ! V-point
375	DO ji = 1, il_jpi
376	ijt = il_jpi-ji+1
377	dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(ijt,il_jpj-2,jk)
378	END DO
379	DO ji = il_jpi/2+1, il_jpi
380	ijt = il_jpi-ji+1
381	dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(ijt,il_jpjm1,jk)
382	END DO
383	CASE ( 'F' ) ! F-point
384	DO ji = 1, il_jpi-1
385	iju = il_jpi-ji
386	dd_array(ji,il_jpj ,jk) = dd_psgn * dd_array(iju,il_jpj-2,jk)
387	END DO
388	dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(1,il_jpj-2,jk)
389	DO ji = il_jpi/2+1, il_jpi-1
390	iju = il_jpi-ji
391	dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(iju,il_jpjm1,jk)
392	END DO
393	END SELECT
394	!
395	CASE DEFAULT ! * closed : the code probably never go through
396	!
397	SELECT CASE ( TRIM(cd_type))
398	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
399	dd_array(:, 1 ,jk) = 0.e0
400	dd_array(:,il_jpj,jk) = 0.e0
401	CASE ( 'F' ) ! F-point
402	dd_array(:,il_jpj,jk) = 0.e0
403	END SELECT
404	!
405	END SELECT ! id_perio
406	!
407	END DO
408
409	END SUBROUTINE lbc__nfd_3d
410	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
411	SUBROUTINE lbc__nfd_2d(dd_array, cd_type, id_perio, dd_psgn)
412	!-------------------------------------------------------------------
413	!> @brief This subroutine manage 2D lateral boundary condition :
414	!> North fold treatment without processor exchanges.
415	!>
416	!> @warning keep only non mpp case
417	!> @warning do not use additional halos
418	!>
419	!> @author J.Paul
420	!> - January, 2015- rewrite with SIREN coding rules
421	!>
422	!> @param[inout] dd_array 2D array
423	!> @param[in] cd_type point grid
424	!> @param[in] id_perio NEMO periodicity of the grid
425	!> @param[in] dd_psgn
426	!-------------------------------------------------------------------
427
428	IMPLICIT NONE
429
430	! Argument
431	REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
432	CHARACTER(LEN=*) , INTENT(IN ) :: cd_type
433	INTEGER(i4) , INTENT(IN ) :: id_perio
434	REAL(dp) , INTENT(IN ) :: dd_psgn
435
436	! local variable
437	INTEGER(i4) :: il_jpi
438	INTEGER(i4) :: il_jpj
439	INTEGER(i4) :: il_jpim1
440	INTEGER(i4) :: il_jpjm1
441
442	INTEGER(i4) :: ijt
443	INTEGER(i4) :: iju
444
445	! loop indices
446	INTEGER(i4) :: ji
447	!----------------------------------------------------------------
448	il_jpi=SIZE(dd_array(:,:),DIM=1)
449	il_jpj=SIZE(dd_array(:,:),DIM=2)
450
451	il_jpim1=il_jpi-1
452	il_jpjm1=il_jpj-1
453
454	SELECT CASE ( id_perio )
455	!
456	CASE ( 3, 4 ) ! * North fold T-point pivot
457	!
458	SELECT CASE ( TRIM(cd_type) )
459	!
460	CASE ( 'T' , 'W' ) ! T- , W-points
461	DO ji = 2, il_jpi
462	ijt=il_jpi-ji+2
463	dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-2)
464	END DO
465	dd_array(1,il_jpj) = dd_psgn * dd_array(3,il_jpj-2)
466	dd_array(1,il_jpj-1) = dd_psgn * dd_array(3,il_jpj-1)
467	DO ji = il_jpi/2+1, il_jpi
468	ijt=il_jpi-ji+2
469	dd_array(ji,il_jpj-1) = dd_psgn * dd_array(ijt,il_jpj-1)
470	END DO
471	CASE ( 'U' ) ! U-point
472	DO ji = 1, il_jpi-1
473	iju = il_jpi-ji+1
474	dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-2)
475	END DO
476	dd_array( 1 ,il_jpj ) = dd_psgn * dd_array( 2 ,il_jpj-2)
477	dd_array(il_jpi,il_jpj ) = dd_psgn * dd_array(il_jpi-1,il_jpj-2)
478	dd_array(1 ,il_jpj-1) = dd_psgn * dd_array(il_jpi ,il_jpj-1)
479	DO ji = il_jpi/2, il_jpi-1
480	iju = il_jpi-ji+1
481	dd_array(ji,il_jpjm1) = dd_psgn * dd_array(iju,il_jpjm1)
482	END DO
483	CASE ( 'V' ) ! V-point
484	DO ji = 2, il_jpi
485	ijt = il_jpi-ji+2
486	dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-3)
487	END DO
488	dd_array( 1 ,il_jpj) = dd_psgn * dd_array( 3 ,il_jpj-3)
489	CASE ( 'F' ) ! F-point
490	DO ji = 1, il_jpi-1
491	iju = il_jpi-ji+1
492	dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-3)
493	END DO
494	dd_array( 1 ,il_jpj) = dd_psgn * dd_array( 2 ,il_jpj-3)
495	dd_array(il_jpi,il_jpj) = dd_psgn * dd_array(il_jpi-1,il_jpj-3)
496	dd_array(il_jpi,il_jpj-1) = dd_psgn * dd_array(il_jpi-1,il_jpj-2)
497	dd_array( 1 ,il_jpj-1) = dd_psgn * dd_array( 2 ,il_jpj-2)
498	CASE ( 'I' ) ! ice U-V point (I-point)
499	dd_array(2,il_jpj) = dd_psgn * dd_array(3,il_jpj-1)
500	DO ji = 3, il_jpi
501	iju = il_jpi - ji + 3
502	dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
503	END DO
504	CASE ( 'J' ) ! first ice U-V point
505	dd_array(2,il_jpj) = dd_psgn * dd_array(3,il_jpj-1)
506	DO ji = 3, il_jpi
507	iju = il_jpi - ji + 3
508	dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
509	END DO
510	CASE ( 'K' ) ! second ice U-V point
511	dd_array(2,il_jpj) = dd_psgn * dd_array(3,il_jpj-1)
512	DO ji = 3, il_jpi
513	iju = il_jpi - ji + 3
514	dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
515	END DO
516	END SELECT
517	!
518	CASE ( 5, 6 ) ! * North fold F-point pivot
519	!
520	SELECT CASE ( TRIM(cd_type) )
521	CASE ( 'T' , 'W' ) ! T-, W-point
522	DO ji = 1, il_jpi
523	ijt = il_jpi-ji+1
524	dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-1)
525	END DO
526	CASE ( 'U' ) ! U-point
527	DO ji = 1, il_jpi-1
528	iju = il_jpi-ji
529	dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
530	END DO
531	dd_array(il_jpi,il_jpj) = dd_psgn * dd_array(1,il_jpj-1)
532	CASE ( 'V' ) ! V-point
533	DO ji = 1, il_jpi
534	ijt = il_jpi-ji+1
535	dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-2)
536	END DO
537	DO ji = il_jpi/2+1, il_jpi
538	ijt = il_jpi-ji+1
539	dd_array(ji,il_jpjm1) = dd_psgn * dd_array(ijt,il_jpjm1)
540	END DO
541	CASE ( 'F' ) ! F-point
542	DO ji = 1, il_jpi-1
543	iju = il_jpi-ji
544	dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-2)
545	END DO
546	dd_array(il_jpi,il_jpj) = dd_psgn * dd_array(1,il_jpj-2)
547	DO ji = il_jpi/2+1, il_jpi-1
548	iju = il_jpi-ji
549	dd_array(ji,il_jpjm1) = dd_psgn * dd_array(iju,il_jpjm1)
550	END DO
551	CASE ( 'I' ) ! ice U-V point (I-point)
552	dd_array( 2 ,il_jpj) = 0.e0
553	DO ji = 2 , il_jpi-1
554	ijt = il_jpi - ji + 2
555	dd_array(ji,il_jpj)= 0.5 * ( dd_array(ji,il_jpj-1) + dd_psgn * dd_array(ijt,il_jpj-1) )
556	END DO
557	CASE ( 'J' ) ! first ice U-V point
558	dd_array( 2 ,il_jpj) = 0.e0
559	DO ji = 2 , il_jpi-1
560	ijt = il_jpi - ji + 2
561	dd_array(ji,il_jpj)= dd_array(ji,il_jpj-1)
562	END DO
563	CASE ( 'K' ) ! second ice U-V point
564	dd_array( 2 ,il_jpj) = 0.e0
565	DO ji = 2 , il_jpi-1
566	ijt = il_jpi - ji + 2
567	dd_array(ji,il_jpj)= dd_array(ijt,il_jpj-1)
568	END DO
569	END SELECT
570	!
571	CASE DEFAULT ! * closed : the code probably never go through
572	!
573	SELECT CASE ( TRIM(cd_type) )
574	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
575	dd_array(:, 1 ) = 0.e0
576	dd_array(:,il_jpj) = 0.e0
577	CASE ( 'F' ) ! F-point
578	dd_array(:,il_jpj) = 0.e0
579	CASE ( 'I' ) ! ice U-V point
580	dd_array(:, 1 ) = 0.e0
581	dd_array(:,il_jpj) = 0.e0
582	CASE ( 'J' ) ! first ice U-V point
583	dd_array(:, 1 ) = 0.e0
584	dd_array(:,il_jpj) = 0.e0
585	CASE ( 'K' ) ! second ice U-V point
586	dd_array(:, 1 ) = 0.e0
587	dd_array(:,il_jpj) = 0.e0
588	END SELECT
589	!
590	END SELECT
591
592	END SUBROUTINE lbc__nfd_2d
593	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
594	SUBROUTINE lbc__hide_lnk_2d(dd_array, cd_type, id_perio, dd_psgn, dd_fill)
595	!-------------------------------------------------------------------
596	!> @brief This subroutine hide lateral boundary conditions on a 2D array (non mpp case)
597	!>
598	!> @details
599	!> dd_psign = -1 : change the sign across the north fold
600	!> = 1 : no change of the sign across the north fold
601	!> = 0 : no change of the sign across the north fold and
602	!> strict positivity preserved: use inner row/column
603	!> for closed boundaries.
604	!> @author J.Paul
605	!> - Marsh, 2015- initial version
606	!>
607	!> @param[inout] dd_array 2D array
608	!> @param[in] cd_type point grid
609	!> @param[in] id_perio NEMO periodicity of the grid
610	!> @param[in] dd_psgn
611	!> @param[in] dd_fill fillValue
612	!-------------------------------------------------------------------
613
614	IMPLICIT NONE
615
616	! Argument
617	REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
618	CHARACTER(LEN=*) , INTENT(IN ) :: cd_type
619	INTEGER(i4) , INTENT(IN ) :: id_perio
620	REAL(dp) , INTENT(IN ) :: dd_psgn
621	REAL(dp) , INTENT(IN ), OPTIONAL :: dd_fill
622
623	! local variable
624	REAL(dp) :: dl_fill
625
626	INTEGER(i4) :: il_jpi
627	INTEGER(i4) :: il_jpj
628	INTEGER(i4) :: il_jpim1
629	!----------------------------------------------------------------
630	IF( PRESENT( dd_fill ) ) THEN ; dl_fill = dd_fill ! set FillValue (zero by default)
631	ELSE ; dl_fill = 0._dp
632	ENDIF
633
634	il_jpi=SIZE(dd_array(:,:),DIM=1)
635	il_jpj=SIZE(dd_array(:,:),DIM=2)
636
637	il_jpim1=il_jpi-1
638
639	!
640	! ! East-West boundaries
641	! ! ====================
642	SELECT CASE ( id_perio )
643	!
644	CASE ( 1 , 4 , 6 ) !** cyclic east-west
645	dd_array( 1 ,:) = dl_fill ! all points
646	dd_array(il_jpi,:) = dl_fill
647	!
648	CASE DEFAULT !** East closed -- West closed
649	SELECT CASE ( TRIM(cd_type) )
650	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
651	dd_array( 1 ,:) = dl_fill
652	dd_array(il_jpi,:) = dl_fill
653	CASE ( 'F' ) ! F-point
654	dd_array(il_jpi,:) = dl_fill
655	END SELECT
656	!
657	END SELECT
658	!
659	! ! North-South boundaries
660	! ! ======================
661	SELECT CASE ( id_perio )
662	!
663	CASE ( 2 ) !** South symmetric -- North closed
664	SELECT CASE ( TRIM(cd_type) )
665	CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points
666	dd_array(:, 1 ) = dl_fill
667	dd_array(:,il_jpj) = dl_fill
668	CASE ( 'V' , 'F' ) ! V-, F-points
669	dd_array(:, 1 ) = dl_fill
670	dd_array(:,il_jpj) = dl_fill
671	END SELECT
672	!
673	CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed
674	SELECT CASE ( TRIM(cd_type) ) ! South : closed
675	CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point
676	dd_array(:, 1 ) = dl_fill
677	END SELECT
678	! ! North fold
679	CALL lbc__hide_nfd( dd_array(:,:), cd_type, id_perio, dd_psgn, &
680	& dd_fill=dl_fill )
681	!
682	CASE DEFAULT !** North closed -- South closed
683	SELECT CASE ( TRIM(cd_type) )
684	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
685	dd_array(:, 1 ) = dl_fill
686	dd_array(:,il_jpj) = dl_fill
687	CASE ( 'F' ) ! F-point
688	dd_array(:,il_jpj) = dl_fill
689	END SELECT
690	!
691	END SELECT
692
693	END SUBROUTINE lbc__hide_lnk_2d
694	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
695	SUBROUTINE lbc__hide_nfd_2d(dd_array, cd_type, id_perio, dd_psgn, dd_fill)
696	!-------------------------------------------------------------------
697	!> @brief This subroutine manage 2D lateral boundary condition :
698	!> hide North fold treatment without processor exchanges.
699	!>
700	!> @warning keep only non mpp case
701	!> @warning do not use additional halos
702	!>
703	!> @author J.Paul
704	!> - Marsh, 2015- initial version
705	!>
706	!> @param[inout] dd_array 2D array
707	!> @param[in] cd_type point grid
708	!> @param[in] id_perio NEMO periodicity of the grid
709	!> @param[in] dd_psgn
710	!> @param[in] dd_fill
711	!-------------------------------------------------------------------
712
713	IMPLICIT NONE
714
715	! Argument
716	REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
717	CHARACTER(LEN=*) , INTENT(IN ) :: cd_type
718	INTEGER(i4) , INTENT(IN ) :: id_perio
719	REAL(dp) , INTENT(IN ) :: dd_psgn
720	REAL(dp) , INTENT(IN ), OPTIONAL :: dd_fill
721
722	! local variable
723	REAL(dp) :: dl_fill
724
725	INTEGER(i4) :: il_jpi
726	INTEGER(i4) :: il_jpj
727	INTEGER(i4) :: il_jpim1
728	INTEGER(i4) :: il_jpjm1
729
730	! loop indices
731	INTEGER(i4) :: ji
732	!----------------------------------------------------------------
733	IF( PRESENT( dd_fill ) ) THEN ; dl_fill = dd_fill ! set FillValue (zero by default)
734	ELSE ; dl_fill = 0._dp
735	ENDIF
736
737	il_jpi=SIZE(dd_array(:,:),DIM=1)
738	il_jpj=SIZE(dd_array(:,:),DIM=2)
739
740	il_jpim1=il_jpi-1
741	il_jpjm1=il_jpj-1
742
743	SELECT CASE ( id_perio )
744	!
745	CASE ( 3, 4 ) ! * North fold T-point pivot
746	!
747	SELECT CASE ( TRIM(cd_type) )
748	!
749	CASE ( 'T' , 'W' ) ! T- , W-points
750	DO ji = 2, il_jpi
751	dd_array(ji,il_jpj) = dl_fill
752	END DO
753	dd_array(1,il_jpj) = dl_fill
754	DO ji = il_jpi/2+2, il_jpi
755	dd_array(ji,il_jpj-1) = dl_fill
756	END DO
757	CASE ( 'U' ) ! U-point
758	DO ji = 1, il_jpi-1
759	dd_array(ji,il_jpj) = dl_fill
760	END DO
761	dd_array( 1 ,il_jpj ) = dl_fill
762	dd_array(il_jpi,il_jpj ) = dl_fill
763	dd_array(1 ,il_jpj-1) = dl_fill
764	DO ji = il_jpi/2+1, il_jpi-1
765	dd_array(ji,il_jpjm1) = dl_fill
766	END DO
767	CASE ( 'V' ) ! V-point
768	DO ji = 2, il_jpi
769	dd_array(ji,il_jpj) = dl_fill
770	END DO
771	dd_array( 1 ,il_jpj) = dl_fill
772	CASE ( 'F' ) ! F-point
773	DO ji = 1, il_jpi-1
774	dd_array(ji,il_jpj) = dl_fill
775	END DO
776	dd_array( 1 ,il_jpj) = dl_fill
777	dd_array(il_jpi,il_jpj) = dl_fill
778	dd_array(il_jpi,il_jpj-1) = dl_fill
779	dd_array( 1 ,il_jpj-1) = dl_fill
780	END SELECT
781	!
782	CASE ( 5, 6 ) ! * North fold F-point pivot
783	!
784	SELECT CASE ( TRIM(cd_type) )
785	CASE ( 'T' , 'W' ) ! T-, W-point
786	DO ji = 1, il_jpi
787	dd_array(ji,il_jpj) = dl_fill
788	END DO
789	CASE ( 'U' ) ! U-point
790	DO ji = 1, il_jpi-1
791	dd_array(ji,il_jpj) = dl_fill
792	END DO
793	dd_array(il_jpi,il_jpj) = dl_fill
794	CASE ( 'V' ) ! V-point
795	DO ji = 1, il_jpi
796	dd_array(ji,il_jpj) = dl_fill
797	END DO
798	DO ji = il_jpi/2+2, il_jpi
799	dd_array(ji,il_jpjm1) = dl_fill
800	END DO
801	CASE ( 'F' ) ! F-point
802	DO ji = 1, il_jpi-1
803	dd_array(ji,il_jpj) = dl_fill
804	END DO
805	dd_array(il_jpi,il_jpj) = dl_fill
806	DO ji = il_jpi/2+2, il_jpi-1
807	dd_array(ji,il_jpjm1) = dl_fill
808	END DO
809	END SELECT
810	!
811	CASE DEFAULT ! * closed : the code probably never go through
812	!
813	SELECT CASE ( TRIM(cd_type) )
814	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
815	dd_array(:, 1 ) = dl_fill
816	dd_array(:,il_jpj) = dl_fill
817	CASE ( 'F' ) ! F-point
818	dd_array(:,il_jpj) = dl_fill
819	END SELECT
820	!
821	END SELECT
822
823	END SUBROUTINE lbc__hide_nfd_2d
824	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
825	END MODULE lbc

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: utils/tools/SIREN/src/lbc.f90 @ 13369

Download in other formats: