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/trunk/src/OCE/LBC – NEMO

Context Navigation

source: NEMO/trunk/src/OCE/LBC/lbc_nfd_generic.h90 @ 14433

Last change on this file since 14433 was 14433, checked in by smasson, 3 years ago
trunk: merge dev_r14312_MPI_Interface into the trunk, #2598
Property svn:keywords set to `Id` Property svn:mime-type set to `text/x-fortran`
File size: 24.1 KB

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

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

Download in other formats: