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 @ 14349

Last change on this file since 14349 was 14349, checked in by smasson, 3 years ago
dev_r14312_MPI_Interface: further simplifications of lbclk and lbcnfd, #2598
Property svn:keywords set to `Id` Property svn:mime-type set to `text/x-fortran`
File size: 24.8 KB

Line
1
2	SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfld )
3	TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
4	CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
5	REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary
6	INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
7	!
8	INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices
9	INTEGER :: ipj, ipk, ipl, ipf ! dimension of the input array
10	INTEGER :: ii1, ii2, ij1, ij2
11	!!----------------------------------------------------------------------
12	!
13	ipj = SIZE(ptab(1)%pt4d,2)
14	ipk = SIZE(ptab(1)%pt4d,3)
15	ipl = SIZE(ptab(1)%pt4d,4)
16	ipf = kfld
17	!
18	DO jf = 1, ipf ! Loop on the number of arrays to be treated
19	!
20	IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot
21	!
22	SELECT CASE ( cd_nat(jf) )
23	CASE ( 'T' , 'W' ) ! T-, W-point
24	DO jl = 1, ipl; DO jk = 1, ipk
25	!
26	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
27	DO jj = 1, nn_hls
28	ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1
29	ij2 = ipj - 2nn_hls + jj - 1 ! ends at: ipj - 2nn_hls + nn_hls - 1 = ipj - nn_hls - 1
30	!
31	DO ji = 1, nn_hls ! first nn_hls points
32	ii1 = ji ! ends at: nn_hls
33	ii2 = 2nn_hls + 2 - ji ! ends at: 2nn_hls + 2 - nn_hls = nn_hls + 2
34	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
35	END DO
36	DO ji = 1, 1 ! point nn_hls+1
37	ii1 = nn_hls + ji
38	ii2 = ii1
39	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
40	END DO
41	DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
42	ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls
43	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2
44	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
45	END DO
46	DO ji = 1, 1 ! point jpiglo - nn_hls + 1
47	ii1 = jpiglo - nn_hls + ji
48	ii2 = nn_hls + ji
49	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
50	END DO
51	DO ji = 1, nn_hls-1 ! last nn_hls-1 points
52	ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo
53	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2
54	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
55	END DO
56	END DO
57	!
58	! line number ipj-nn_hls : right half
59	DO jj = 1, 1
60	ij1 = ipj - nn_hls
61	ij2 = ij1 ! same line
62	!
63	DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
64	ii1 = jpiglo/2 + ji + 1 ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls
65	ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 2
66	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
67	END DO
68	DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)
69	! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls
70	ii1 = ji ! ends at: nn_hls
71	ii2 = 2nn_hls + 2 - ji ! ends at: 2nn_hls + 2 - nn_hls = nn_hls + 2
72	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
73	END DO
74	! ! last nn_hls-1 points: have been / will done by e-w periodicity
75	END DO
76	!
77	END DO; END DO
78	CASE ( 'U' ) ! U-point
79	DO jl = 1, ipl; DO jk = 1, ipk
80	!
81	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
82	DO jj = 1, nn_hls
83	ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1
84	ij2 = ipj - 2nn_hls + jj - 1 ! ends at: ipj - 2nn_hls + nn_hls - 1 = ipj - nn_hls - 1
85	!
86	DO ji = 1, nn_hls ! first nn_hls points
87	ii1 = ji ! ends at: nn_hls
88	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
89	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
90	END DO
91	DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
92	ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
93	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
94	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
95	END DO
96	DO ji = 1, nn_hls ! last nn_hls points
97	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
98	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
99	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
100	END DO
101	END DO
102	!
103	! line number ipj-nn_hls : right half
104	DO jj = 1, 1
105	ij1 = ipj - nn_hls
106	ij2 = ij1 ! same line
107	!
108	DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
109	ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
110	ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1
111	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
112	END DO
113	DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)
114	! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls
115	ii1 = ji ! ends at: nn_hls
116	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
117	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
118	END DO
119	! ! last nn_hls-1 points: have been / will done by e-w periodicity
120	END DO
121	!
122	END DO; END DO
123	CASE ( 'V' ) ! V-point
124	DO jl = 1, ipl; DO jk = 1, ipk
125	!
126	! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full
127	DO jj = 1, nn_hls+1
128	ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls
129	ij2 = ipj - 2nn_hls + jj - 2 ! ends at: ipj - 2nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1
130	!
131	DO ji = 1, nn_hls ! first nn_hls points
132	ii1 = ji ! ends at: nn_hls
133	ii2 = 2nn_hls + 2 - ji ! ends at: 2nn_hls + 2 - nn_hls = nn_hls + 2
134	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
135	END DO
136	DO ji = 1, 1 ! point nn_hls+1
137	ii1 = nn_hls + ji
138	ii2 = ii1
139	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
140	END DO
141	DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
142	ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls
143	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2
144	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
145	END DO
146	DO ji = 1, 1 ! point jpiglo - nn_hls + 1
147	ii1 = jpiglo - nn_hls + ji
148	ii2 = nn_hls + ji
149	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
150	END DO
151	DO ji = 1, nn_hls-1 ! last nn_hls-1 points
152	ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo
153	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2
154	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
155	END DO
156	END DO
157	!
158	END DO; END DO
159	CASE ( 'F' ) ! F-point
160	DO jl = 1, ipl; DO jk = 1, ipk
161	!
162	! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full
163	DO jj = 1, nn_hls+1
164	ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls
165	ij2 = ipj - 2nn_hls + jj - 2 ! ends at: ipj - 2nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1
166	!
167	DO ji = 1, nn_hls ! first nn_hls points
168	ii1 = ji ! ends at: nn_hls
169	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
170	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
171	END DO
172	DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
173	ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
174	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
175	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
176	END DO
177	DO ji = 1, nn_hls ! last nn_hls points
178	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
179	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
180	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
181	END DO
182	END DO
183	!
184	END DO; END DO
185	END SELECT ! cd_nat(jf)
186	!
187	ENDIF ! c_NFtype == 'T'
188	!
189	IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot
190	!
191	SELECT CASE ( cd_nat(jf) )
192	CASE ( 'T' , 'W' ) ! T-, W-point
193	DO jl = 1, ipl; DO jk = 1, ipk
194	!
195	! first: line number ipj-nn_hls : 3 points
196	DO jj = 1, 1
197	ij1 = ipj - nn_hls
198	ij2 = ij1 ! same line
199	!
200	DO ji = 1, 1 ! points from jpiglo/2+1
201	ii1 = jpiglo/2 + ji
202	ii2 = jpiglo/2 - ji + 1
203	ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign...
204	END DO
205	DO ji = 1, 1 ! points jpiglo - nn_hls
206	ii1 = jpiglo - nn_hls + ji - 1
207	ii2 = nn_hls + ji
208	ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign...
209	END DO
210	DO ji = 1, 1 ! point nn_hls: redo it just in case (if e-w periodocity already done)
211	! ! as we just changed point jpiglo - nn_hls
212	ii1 = nn_hls + ji - 1
213	ii2 = nn_hls + ji
214	ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign...
215	END DO
216	END DO
217	!
218	! Second: last nn_hls lines (from ipj to ipj-nn_hls+1) : full
219	DO jj = 1, nn_hls
220	ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls
221	ij2 = ipj - 2nn_hls + jj ! ends at: ipj - 2nn_hls + nn_hls = ipj - nn_hls
222	!
223	DO ji = 1, nn_hls ! first nn_hls points
224	ii1 = ji ! ends at: nn_hls
225	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
226	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
227	END DO
228	DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
229	ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
230	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
231	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
232	END DO
233	DO ji = 1, nn_hls ! last nn_hls points
234	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
235	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
236	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
237	END DO
238	END DO
239	!
240	END DO; END DO
241	CASE ( 'U' ) ! U-point
242	DO jl = 1, ipl; DO jk = 1, ipk
243	!
244	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
245	DO jj = 1, nn_hls
246	ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls
247	ij2 = ipj - 2nn_hls + jj ! ends at: ipj - 2nn_hls + nn_hls = ipj - nn_hls
248	!
249	DO ji = 1, nn_hls-1 ! first nn_hls-1 points
250	ii1 = ji ! ends at: nn_hls-1
251	ii2 = 2nn_hls - ji ! ends at: 2nn_hls - ( nn_hls - 1 ) = nn_hls + 1
252	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
253	END DO
254	DO ji = 1, 1 ! point nn_hls
255	ii1 = nn_hls + ji - 1
256	ii2 = jpiglo - ii1
257	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
258	END DO
259	DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls)
260	ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1
261	ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1
262	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
263	END DO
264	DO ji = 1, 1 ! point jpiglo - nn_hls
265	ii1 = jpiglo - nn_hls + ji - 1
266	ii2 = ii1
267	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
268	END DO
269	DO ji = 1, nn_hls ! last nn_hls points
270	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
271	ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls
272	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
273	END DO
274	END DO
275	!
276	END DO; END DO
277	CASE ( 'V' ) ! V-point
278	DO jl = 1, ipl; DO jk = 1, ipk
279	!
280	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
281	DO jj = 1, nn_hls
282	ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1
283	ij2 = ipj - 2nn_hls + jj - 1 ! ends at: ipj - 2nn_hls + nn_hls - 1 = ipj - nn_hls - 1
284	!
285	DO ji = 1, nn_hls ! first nn_hls points
286	ii1 = ji ! ends at: nn_hls
287	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
288	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
289	END DO
290	DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
291	ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
292	ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
293	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
294	END DO
295	DO ji = 1, nn_hls ! last nn_hls points
296	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
297	ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
298	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
299	END DO
300	END DO
301	!
302	! line number ipj-nn_hls : right half
303	DO jj = 1, 1
304	ij1 = ipj - nn_hls
305	ij2 = ij1 ! same line
306	!
307	DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)
308	ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
309	ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1
310	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
311	END DO
312	DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)
313	! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls
314	ii1 = ji ! ends at: nn_hls
315	ii2 = 2nn_hls + 1 - ji ! ends at: 2nn_hls + 1 - nn_hls = nn_hls + 1
316	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
317	END DO
318	! ! last nn_hls points: have been / will done by e-w periodicity
319	END DO
320	!
321	END DO; END DO
322	CASE ( 'F' ) ! F-point
323	DO jl = 1, ipl; DO jk = 1, ipk
324	!
325	! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
326	DO jj = 1, nn_hls
327	ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1
328	ij2 = ipj - 2nn_hls + jj - 1 ! ends at: ipj - 2nn_hls + nn_hls - 1 = ipj - nn_hls - 1
329	!
330	DO ji = 1, nn_hls-1 ! first nn_hls-1 points
331	ii1 = ji ! ends at: nn_hls-1
332	ii2 = 2nn_hls - ji ! ends at: 2nn_hls - ( nn_hls - 1 ) = nn_hls + 1
333	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
334	END DO
335	DO ji = 1, 1 ! point nn_hls
336	ii1 = nn_hls + ji - 1
337	ii2 = jpiglo - ii1
338	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
339	END DO
340	DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls)
341	ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1
342	ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1
343	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
344	END DO
345	DO ji = 1, 1 ! point jpiglo - nn_hls
346	ii1 = jpiglo - nn_hls + ji - 1
347	ii2 = ii1
348	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
349	END DO
350	DO ji = 1, nn_hls ! last nn_hls points
351	ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
352	ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls
353	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
354	END DO
355	END DO
356	!
357	! line number ipj-nn_hls : right half
358	DO jj = 1, 1
359	ij1 = ipj - nn_hls
360	ij2 = ij1 ! same line
361	!
362	DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+1 to jpiglo - nn_hls-1 (note: Ni0glo = jpiglo - 2*nn_hls)
363	ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
364	ii2 = jpiglo/2 - ji ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1
365	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
366	END DO
367	DO ji = 1, nn_hls-1 ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done)
368	! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hl-1
369	ii1 = ji ! ends at: nn_hls
370	ii2 = 2nn_hls - ji ! ends at: 2nn_hls - ( nn_hls - 1 ) = nn_hls + 1
371	ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
372	END DO
373	! ! last nn_hls points: have been / will done by e-w periodicity
374	END DO
375	!
376	END DO; END DO
377	END SELECT ! cd_nat(jf)
378	!
379	ENDIF ! c_NFtype == 'F'
380	!
381	END DO ! ipf
382	!
383	END SUBROUTINE lbc_nfd_/**/PRECISION
384

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

Download in other formats: