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.

lbc_nfd_ext_generic.h90 in branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

Context Navigation

source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_ext_generic.h90 @ 8854

Last change on this file since 8854 was 8854, checked in by acc, 6 years ago
Branch 2017/dev_r8126_ROBUST08_no_ghost. Minor change to lbc_nfd_ext_generic.h90 following more detailed testing of icebergs across the north-fold. Icebergs now cross seamlessly in an ORCA2LIM3_PISCES test but the need for this change is not clear. Investigations continue.
File size: 6.8 KB

Line
1	! !== IN: ptab is an array ==!
2	#define NAT_IN(k) cd_nat
3	#define SGN_IN(k) psgn
4	#define F_SIZE(ptab) 1
5	#if defined DIM_2d
6	# define ARRAY_IN(i,j,k,l,f) ptab(i,j)
7	# define K_SIZE(ptab) 1
8	# define L_SIZE(ptab) 1
9	#endif
10	#define ARRAY_TYPE(i,j,k,l,f) REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
11
12	SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, ipr2dj )
13	ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied
14	CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points
15	REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary
16	INTEGER , INTENT(in ) :: ipr2dj ! extra halo width to exchange
17	!
18	INTEGER :: ji, jj, jk, jl, jh, jf ! dummy loop indices
19	INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array
20	INTEGER :: ijt, iju, ipjm1
21	!!----------------------------------------------------------------------
22	!
23	ipk = K_SIZE(ptab) ! 3rd dimension
24	ipl = L_SIZE(ptab) ! 4th -
25	ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers)
26	!
27	!
28	SELECT CASE ( jpni )
29	CASE ( 1 ) ; ipj = nlcj ! 1 proc only along the i-direction
30	CASE DEFAULT ; ipj = 4 ! several proc along the i-direction
31	END SELECT
32	!
33	IF (jpni > 1 ) ipj = ipj + ipr2dj
34	!
35	ipjm1 = ipj-1
36
37	!
38	DO jf = 1, ipf ! Loop on the number of arrays to be treated
39	!
40	SELECT CASE ( npolj )
41	!
42	CASE ( 3 , 4 ) ! * North fold T-point pivot
43	!
44	SELECT CASE ( NAT_IN(jf) )
45	CASE ( 'T' , 'W' ) ! T-, W-point
46	DO jh = 0, ipr2dj
47	DO ji = 2, jpiglo
48	ijt = jpiglo-ji+2
49	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
50	END DO
51	ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-2-jh,:,:,jf)
52	END DO
53	DO ji = jpiglo/2+1, jpiglo
54	ijt = jpiglo-ji+2
55	ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf)
56	END DO
57	CASE ( 'U' ) ! U-point
58	DO jh = 0, ipr2dj
59	DO ji = 1, jpiglo-1
60	iju = jpiglo-ji+1
61	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
62	END DO
63	ARRAY_IN( 1 ,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ipj-2-jh,:,:,jf)
64	ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-2-jh,:,:,jf)
65	END DO
66	DO ji = jpiglo/2, jpiglo-1
67	iju = jpiglo-ji+1
68	ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf)
69	END DO
70	CASE ( 'V' ) ! V-point
71	DO jh = 0, ipr2dj
72	DO ji = 2, jpiglo
73	ijt = jpiglo-ji+2
74	ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
75	ARRAY_IN(ji,ipj+jh ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-3-jh,:,:,jf)
76	END DO
77	ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-3-jh,:,:,jf)
78	END DO
79	CASE ( 'F' ) ! F-point
80	DO jh = 0, ipr2dj
81	DO ji = 1, jpiglo-1
82	iju = jpiglo-ji+1
83	ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
84	ARRAY_IN(ji,ipj+jh ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-3-jh,:,:,jf)
85	END DO
86	ARRAY_IN( 1 ,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ipj-3-jh,:,:,jf)
87	ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf)
88	END DO
89	END SELECT
90	!
91	CASE ( 5 , 6 ) ! * North fold F-point pivot
92	!
93	SELECT CASE ( NAT_IN(jf) )
94	CASE ( 'T' , 'W' ) ! T-, W-point
95	DO jh = 0, ipr2dj
96	DO ji = 1, jpiglo
97	ijt = jpiglo-ji+1
98	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-1-jh,:,:,jf)
99	END DO
100	END DO
101	CASE ( 'U' ) ! U-point
102	DO jh = 0, ipr2dj
103	DO ji = 1, jpiglo-1
104	iju = jpiglo-ji
105	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-1-jh,:,:,jf)
106	END DO
107	ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(1,ipj-1-jh,:,:,jf)
108	END DO
109	CASE ( 'V' ) ! V-point
110	DO jh = 0, ipr2dj
111	DO ji = 1, jpiglo
112	ijt = jpiglo-ji+1
113	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
114	END DO
115	END DO
116	DO ji = jpiglo/2+1, jpiglo
117	ijt = jpiglo-ji+1
118	ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf)
119	END DO
120	CASE ( 'F' ) ! F-point
121	DO jh = 0, ipr2dj
122	DO ji = 1, jpiglo-1
123	iju = jpiglo-ji
124	ARRAY_IN(ji,ipj+jh ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
125	END DO
126	ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(1,ipj-2-jh,:,:,jf)
127	END DO
128	DO ji = jpiglo/2+1, jpiglo-1
129	iju = jpiglo-ji
130	ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf)
131	END DO
132	END SELECT
133	!
134	CASE DEFAULT ! * closed : the code probably never go through
135	!
136	SELECT CASE ( NAT_IN(jf) )
137	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
138	ARRAY_IN(:, 1:1-ipr2dj ,:,:,jf) = 0._wp
139	ARRAY_IN(:,ipj:ipj+ipr2dj,:,:,jf) = 0._wp
140	CASE ( 'F' ) ! F-point
141	ARRAY_IN(:,ipj:ipj+ipr2dj,:,:,jf) = 0._wp
142	END SELECT
143	!
144	END SELECT ! npolj
145	!
146	END DO
147	!
148	END SUBROUTINE ROUTINE_NFD
149
150	#undef ARRAY_TYPE
151	#undef ARRAY_IN
152	#undef NAT_IN
153	#undef SGN_IN
154	#undef K_SIZE
155	#undef L_SIZE
156	#undef F_SIZE

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

Download in other formats:

Original Format