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_generic.h90 in NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC – NEMO

Context Navigation

source: NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_generic.h90 @ 14314

Last change on this file since 14314 was 14314, checked in by smasson, 3 years ago
dev_r14312_MPI_Interface: first implementation, #2598
Property svn:keywords set to `Id` Property svn:mime-type set to `text/x-fortran`
File size: 27.6 KB

Line
1	#if defined MULTI
2	# define NAT_IN(k) cd_nat(k)
3	# define SGN_IN(k) psgn(k)
4	# define F_SIZE(ptab) kfld
5	# if defined DIM_2d
6	# if defined SINGLE_PRECISION
7	# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_sp),INTENT(inout)::ptab(f)
8	# else
9	# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_dp),INTENT(inout)::ptab(f)
10	# endif
11	# define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j)
12	# define J_SIZE(ptab) SIZE(ptab(1)%pt2d,2)
13	# define K_SIZE(ptab) 1
14	# define L_SIZE(ptab) 1
15	# endif
16	# if defined DIM_3d
17	# if defined SINGLE_PRECISION
18	# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_sp),INTENT(inout)::ptab(f)
19	# else
20	# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_dp),INTENT(inout)::ptab(f)
21	# endif
22	# define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k)
23	# define J_SIZE(ptab) SIZE(ptab(1)%pt3d,2)
24	# define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3)
25	# define L_SIZE(ptab) 1
26	# endif
27	# if defined DIM_4d
28	# if defined SINGLE_PRECISION
29	# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp),INTENT(inout)::ptab(f)
30	# else
31	# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp),INTENT(inout)::ptab(f)
32	# endif
33	# define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l)
34	# define J_SIZE(ptab) SIZE(ptab(1)%pt4d,2)
35	# define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3)
36	# define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4)
37	# endif
38	#else
39	! !== IN: ptab is an array ==!
40	# define NAT_IN(k) cd_nat
41	# define SGN_IN(k) psgn
42	# define F_SIZE(ptab) 1
43	# if defined DIM_2d
44	# define ARRAY_IN(i,j,k,l,f) ptab(i,j)
45	# define J_SIZE(ptab) SIZE(ptab,2)
46	# define K_SIZE(ptab) 1
47	# define L_SIZE(ptab) 1
48	# endif
49	# if defined DIM_3d
50	# define ARRAY_IN(i,j,k,l,f) ptab(i,j,k)
51	# define J_SIZE(ptab) SIZE(ptab,2)
52	# define K_SIZE(ptab) SIZE(ptab,3)
53	# define L_SIZE(ptab) 1
54	# endif
55	# if defined DIM_4d
56	# define ARRAY_IN(i,j,k,l,f) ptab(i,j,k,l)
57	# define J_SIZE(ptab) SIZE(ptab,2)
58	# define K_SIZE(ptab) SIZE(ptab,3)
59	# define L_SIZE(ptab) SIZE(ptab,4)
60	# endif
61	# if defined SINGLE_PRECISION
62	# define ARRAY_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
63	# else
64	# define ARRAY_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
65	# endif
66	#endif
67
68	# if defined SINGLE_PRECISION
69	# define PRECISION sp
70	# else
71	# define PRECISION dp
72	# endif
73
74	#if defined MULTI
75	SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
76	INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
77	#else
78	SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn )
79	#endif
80	ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied
81	CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points
82	REAL(PRECISION) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary
83	!
84	INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices
85	INTEGER :: ipj, ipk, ipl, ipf ! dimension of the input array
86	INTEGER :: ii1, ii2, ij1, ij2
87	!!----------------------------------------------------------------------
88	!
89	ipj = J_SIZE(ptab) ! 2nd dimension
90	ipk = K_SIZE(ptab) ! 3rd -
91	ipl = L_SIZE(ptab) ! 4th -
92	ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers)
93	!
94	DO jf = 1, ipf ! Loop on the number of arrays to be treated
95	!
96	IF( l_NFoldT ) THEN ! * North fold T-point pivot
97	!
98	SELECT CASE ( NAT_IN(jf) )
99	CASE ( 'T' , 'W' ) ! T-, W-point
100	DO jl = 1, ipl; DO jk = 1, ipk
101	!
102	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
103	DO jj = 1, nn_hls
104	ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1
105	ij2 = ipj - 2nn_hls + jj - 1 ! ends at: ipj - 2nn_hls + nn_hls - 1 = ipj - nn_hls - 1
106	!
107	DO ji = 1, nn_hls ! first nn_hls points
108	ii1 = ji ! ends at: nn_hls
109	ii2 = 2nn_hls + 2 - ji ! ends at: 2nn_hls + 2 - nn_hls = nn_hls + 2
110	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
111	END DO
112	DO ji = 1, 1 ! point nn_hls+1
113	ii1 = nn_hls + ji
114	ii2 = ii1
115	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
116	END DO
117	DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
118	ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls
119	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2
120	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
121	END DO
122	DO ji = 1, 1 ! point jpiglo - nn_hls + 1
123	ii1 = jpiglo - nn_hls + ji
124	ii2 = nn_hls + ji
125	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
126	END DO
127	DO ji = 1, nn_hls-1 ! last nn_hls-1 points
128	ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo
129	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2
130	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
131	END DO
132	END DO
133	!
134	! line number ipj-nn_hls : right half
135	DO jj = 1, 1
136	ij1 = ipj - nn_hls
137	ij2 = ij1 ! same line
138	!
139	DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
140	ii1 = jpiglo/2 + ji + 1 ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls
141	ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 2
142	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
143	END DO
144	DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)
145	! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls
146	ii1 = ji ! ends at: nn_hls
147	ii2 = 2nn_hls + 2 - ji ! ends at: 2nn_hls + 2 - nn_hls = nn_hls + 2
148	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
149	END DO
150	! ! last nn_hls-1 points: have been / will done by e-w periodicity
151	END DO
152	!
153	END DO; END DO
154	CASE ( 'U' ) ! U-point
155	DO jl = 1, ipl; DO jk = 1, ipk
156	!
157	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
158	DO jj = 1, nn_hls
159	ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1
160	ij2 = ipj - 2nn_hls + jj - 1 ! ends at: ipj - 2nn_hls + nn_hls - 1 = ipj - nn_hls - 1
161	!
162	DO ji = 1, nn_hls ! first nn_hls points
163	ii1 = ji ! ends at: nn_hls
164	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
165	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
166	END DO
167	DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
168	ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
169	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
170	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
171	END DO
172	DO ji = 1, nn_hls ! last nn_hls points
173	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
174	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
175	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
176	END DO
177	END DO
178	!
179	! line number ipj-nn_hls : right half
180	DO jj = 1, 1
181	ij1 = ipj - nn_hls
182	ij2 = ij1 ! same line
183	!
184	DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
185	ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
186	ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1
187	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
188	END DO
189	DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)
190	! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls
191	ii1 = ji ! ends at: nn_hls
192	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
193	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
194	END DO
195	! ! last nn_hls-1 points: have been / will done by e-w periodicity
196	END DO
197	!
198	END DO; END DO
199	CASE ( 'V' ) ! V-point
200	DO jl = 1, ipl; DO jk = 1, ipk
201	!
202	! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full
203	DO jj = 1, nn_hls+1
204	ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls
205	ij2 = ipj - 2nn_hls + jj - 2 ! ends at: ipj - 2nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1
206	!
207	DO ji = 1, nn_hls ! first nn_hls points
208	ii1 = ji ! ends at: nn_hls
209	ii2 = 2nn_hls + 2 - ji ! ends at: 2nn_hls + 2 - nn_hls = nn_hls + 2
210	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
211	END DO
212	DO ji = 1, 1 ! point nn_hls+1
213	ii1 = nn_hls + ji
214	ii2 = ii1
215	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
216	END DO
217	DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
218	ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls
219	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2
220	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
221	END DO
222	DO ji = 1, 1 ! point jpiglo - nn_hls + 1
223	ii1 = jpiglo - nn_hls + ji
224	ii2 = nn_hls + ji
225	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
226	END DO
227	DO ji = 1, nn_hls-1 ! last nn_hls-1 points
228	ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo
229	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2
230	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
231	END DO
232	END DO
233	!
234	END DO; END DO
235	CASE ( 'F' ) ! F-point
236	DO jl = 1, ipl; DO jk = 1, ipk
237	!
238	! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full
239	DO jj = 1, nn_hls+1
240	ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls
241	ij2 = ipj - 2nn_hls + jj - 2 ! ends at: ipj - 2nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1
242	!
243	DO ji = 1, nn_hls ! first nn_hls points
244	ii1 = ji ! ends at: nn_hls
245	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
246	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
247	END DO
248	DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
249	ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
250	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
251	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
252	END DO
253	DO ji = 1, nn_hls ! last nn_hls points
254	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
255	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
256	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
257	END DO
258	END DO
259	!
260	END DO; END DO
261	END SELECT ! NAT_IN(jf)
262	!
263	ENDIF ! l_NFoldT
264	!
265	IF( l_NFoldF ) THEN ! * North fold F-point pivot
266	!
267	SELECT CASE ( NAT_IN(jf) )
268	CASE ( 'T' , 'W' ) ! T-, W-point
269	DO jl = 1, ipl; DO jk = 1, ipk
270	!
271	! first: line number ipj-nn_hls : 3 points
272	DO jj = 1, 1
273	ij1 = ipj - nn_hls
274	ij2 = ij1 ! same line
275	!
276	DO ji = 1, 1 ! points from jpiglo/2+1
277	ii1 = jpiglo/2 + ji
278	ii2 = jpiglo/2 - ji + 1
279	ARRAY_IN(ii1,ij1,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) ! Warning: pb with sign...
280	END DO
281	DO ji = 1, 1 ! points jpiglo - nn_hls
282	ii1 = jpiglo - nn_hls + ji - 1
283	ii2 = nn_hls + ji
284	ARRAY_IN(ii1,ij1,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) ! Warning: pb with sign...
285	END DO
286	DO ji = 1, 1 ! point nn_hls: redo it just in case (if e-w periodocity already done)
287	! ! as we just changed point jpiglo - nn_hls
288	ii1 = nn_hls + ji - 1
289	ii2 = nn_hls + ji
290	ARRAY_IN(ii1,ij1,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) ! Warning: pb with sign...
291	END DO
292	END DO
293	!
294	! Second: last nn_hls lines (from ipj to ipj-nn_hls+1) : full
295	DO jj = 1, nn_hls
296	ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls
297	ij2 = ipj - 2nn_hls + jj ! ends at: ipj - 2nn_hls + nn_hls = ipj - nn_hls
298	!
299	DO ji = 1, nn_hls ! first nn_hls points
300	ii1 = ji ! ends at: nn_hls
301	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
302	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
303	END DO
304	DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
305	ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
306	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
307	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
308	END DO
309	DO ji = 1, nn_hls ! last nn_hls points
310	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
311	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
312	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
313	END DO
314	END DO
315	!
316	END DO; END DO
317	CASE ( 'U' ) ! U-point
318	DO jl = 1, ipl; DO jk = 1, ipk
319	!
320	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
321	DO jj = 1, nn_hls
322	ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls
323	ij2 = ipj - 2nn_hls + jj ! ends at: ipj - 2nn_hls + nn_hls = ipj - nn_hls
324	!
325	DO ji = 1, nn_hls-1 ! first nn_hls-1 points
326	ii1 = ji ! ends at: nn_hls-1
327	ii2 = 2nn_hls - ji ! ends at: 2nn_hls - ( nn_hls - 1 ) = nn_hls + 1
328	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
329	END DO
330	DO ji = 1, 1 ! point nn_hls
331	ii1 = nn_hls + ji - 1
332	ii2 = jpiglo - ii1
333	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
334	END DO
335	DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls)
336	ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1
337	ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1
338	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
339	END DO
340	DO ji = 1, 1 ! point jpiglo - nn_hls
341	ii1 = jpiglo - nn_hls + ji - 1
342	ii2 = ii1
343	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
344	END DO
345	DO ji = 1, nn_hls ! last nn_hls points
346	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
347	ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls
348	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
349	END DO
350	END DO
351	!
352	END DO; END DO
353	CASE ( 'V' ) ! V-point
354	DO jl = 1, ipl; DO jk = 1, ipk
355	!
356	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
357	DO jj = 1, nn_hls
358	ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1
359	ij2 = ipj - 2nn_hls + jj - 1 ! ends at: ipj - 2nn_hls + nn_hls - 1 = ipj - nn_hls - 1
360	!
361	DO ji = 1, nn_hls ! first nn_hls points
362	ii1 = ji ! ends at: nn_hls
363	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
364	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
365	END DO
366	DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
367	ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
368	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
369	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
370	END DO
371	DO ji = 1, nn_hls ! last nn_hls points
372	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
373	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
374	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
375	END DO
376	END DO
377	!
378	! line number ipj-nn_hls : right half
379	DO jj = 1, 1
380	ij1 = ipj - nn_hls
381	ij2 = ij1 ! same line
382	!
383	DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
384	ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
385	ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1
386	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
387	END DO
388	DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)
389	! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls
390	ii1 = ji ! ends at: nn_hls
391	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
392	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
393	END DO
394	! ! last nn_hls points: have been / will done by e-w periodicity
395	END DO
396	!
397	END DO; END DO
398	CASE ( 'F' ) ! F-point
399	DO jl = 1, ipl; DO jk = 1, ipk
400	!
401	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
402	DO jj = 1, nn_hls
403	ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1
404	ij2 = ipj - 2nn_hls + jj - 1 ! ends at: ipj - 2nn_hls + nn_hls - 1 = ipj - nn_hls - 1
405	!
406	DO ji = 1, nn_hls-1 ! first nn_hls-1 points
407	ii1 = ji ! ends at: nn_hls-1
408	ii2 = 2nn_hls - ji ! ends at: 2nn_hls - ( nn_hls - 1 ) = nn_hls + 1
409	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
410	END DO
411	DO ji = 1, 1 ! point nn_hls
412	ii1 = nn_hls + ji - 1
413	ii2 = jpiglo - ii1
414	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
415	END DO
416	DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls)
417	ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1
418	ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1
419	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
420	END DO
421	DO ji = 1, 1 ! point jpiglo - nn_hls
422	ii1 = jpiglo - nn_hls + ji - 1
423	ii2 = ii1
424	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
425	END DO
426	DO ji = 1, nn_hls ! last nn_hls points
427	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
428	ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls
429	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
430	END DO
431	END DO
432	!
433	! line number ipj-nn_hls : right half
434	DO jj = 1, 1
435	ij1 = ipj - nn_hls
436	ij2 = ij1 ! same line
437	!
438	DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+1 to jpiglo - nn_hls-1 (note: Ni0glo = jpiglo - 2*nn_hls)
439	ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
440	ii2 = jpiglo/2 - ji ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1
441	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
442	END DO
443	DO ji = 1, nn_hls-1 ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done)
444	! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hl-1
445	ii1 = ji ! ends at: nn_hls
446	ii2 = 2nn_hls - ji ! ends at: 2nn_hls - ( nn_hls - 1 ) = nn_hls + 1
447	ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
448	END DO
449	! ! last nn_hls points: have been / will done by e-w periodicity
450	END DO
451	!
452	END DO; END DO
453	END SELECT ! NAT_IN(jf)
454	!
455	ENDIF ! l_NFoldF
456	!
457	END DO ! ipf
458	!
459	END SUBROUTINE ROUTINE_NFD
460
461	#undef PRECISION
462	#undef ARRAY_TYPE
463	#undef ARRAY_IN
464	#undef NAT_IN
465	#undef SGN_IN
466	#undef J_SIZE
467	#undef K_SIZE
468	#undef L_SIZE
469	#undef F_SIZE

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

Download in other formats: