Context Navigation

mpp_lnk_generic.h90 @ 8809

Last change on this file since 8809 was 8758, checked in by acc, 6 years ago

Branch 2017/dev_r8126_ROBUST08_no_ghost. Changes to eliminate ghost rows and columns. Currently the halo width is still fixed as 1 but a single variable (nn_hls) has been introduced for the halo-size in preparation for allowing this to vary. nn_hls replaces jpreci and jprecj. These changes have passed full SETTE tests but iceberg exchanges across the north-fold remain untested (SETTE tests only release bergs in the SO) and will require further attention. Note layout.dat now reports the jpi and jpj values for the reporting processor only.

File size: 12.7 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	# define OPT_K(k) ,ipf
6	# if defined DIM_2d
7	# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D) , INTENT(inout) :: ptab(f)
8	# define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j)
9	# define K_SIZE(ptab) 1
10	# define L_SIZE(ptab) 1
11	# endif
12	# if defined DIM_3d
13	# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D) , INTENT(inout) :: ptab(f)
14	# define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k)
15	# define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3)
16	# define L_SIZE(ptab) 1
17	# endif
18	# if defined DIM_4d
19	# define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D) , INTENT(inout) :: ptab(f)
20	# define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l)
21	# define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3)
22	# define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4)
23	# endif
24	#else
25	# define ARRAY_TYPE(i,j,k,l,f) REAL(wp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f)
26	# define NAT_IN(k) cd_nat
27	# define SGN_IN(k) psgn
28	# define F_SIZE(ptab) 1
29	# define OPT_K(k)
30	# if defined DIM_2d
31	# define ARRAY_IN(i,j,k,l,f) ptab(i,j)
32	# define K_SIZE(ptab) 1
33	# define L_SIZE(ptab) 1
34	# endif
35	# if defined DIM_3d
36	# define ARRAY_IN(i,j,k,l,f) ptab(i,j,k)
37	# define K_SIZE(ptab) SIZE(ptab,3)
38	# define L_SIZE(ptab) 1
39	# endif
40	# if defined DIM_4d
41	# define ARRAY_IN(i,j,k,l,f) ptab(i,j,k,l)
42	# define K_SIZE(ptab) SIZE(ptab,3)
43	# define L_SIZE(ptab) SIZE(ptab,4)
44	# endif
45	#endif
46
47	#if defined MULTI
48	SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn, kfld, cd_mpp, pval )
49	INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
50	#else
51	SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn , cd_mpp, pval )
52	#endif
53	ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied
54	CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points
55	REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary
56	CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only
57	REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries)
58	!
59	INTEGER :: ji, jj, jk, jl, jh, jf ! dummy loop indices
60	INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array
61	INTEGER :: imigr, iihom, ijhom ! local integers
62	INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend
63	REAL(wp) :: zland
64	LOGICAL :: ll_Iperio, ll_Jperio
65	INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend
66	REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! north-south & south-north halos
67	REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! east -west & west - east halos
68	!!----------------------------------------------------------------------
69	!
70	ipk = K_SIZE(ptab) ! 3rd dimension
71	ipl = L_SIZE(ptab) ! 4th -
72	ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers)
73	!
74	ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2), &
75	& zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2) )
76	!
77	ll_Iperio = nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6)
78	ll_Jperio = nbondj == 2 .AND. jperio == 7
79	!
80	IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value
81	ELSE ; zland = 0._wp ! zero by default
82	ENDIF
83
84	! ------------------------------- !
85	! standard boundary treatment ! ! CAUTION: semi-column notation is often impossible
86	! ------------------------------- !
87	!
88	IF( PRESENT( cd_mpp ) ) THEN !== halos filled with inner values ==!
89	!
90	DO jf = 1, ipf ! number of arrays to be treated
91	!
92	DO jl = 1, ipl ! CAUTION: ptab is defined only between nld and nle
93	DO jk = 1, ipk
94	DO jj = nlcj+1, jpj ! added line(s) (inner only)
95	ARRAY_IN(nldi :nlei ,jj,jk,jl,jf) = ARRAY_IN(nldi:nlei,nlej,jk,jl,jf)
96	ARRAY_IN(1 :nldi-1,jj,jk,jl,jf) = ARRAY_IN(nldi ,nlej,jk,jl,jf)
97	ARRAY_IN(nlei+1:nlci ,jj,jk,jl,jf) = ARRAY_IN( nlei,nlej,jk,jl,jf)
98	END DO
99	DO ji = nlci+1, jpi ! added column(s) (full)
100	ARRAY_IN(ji,nldj :nlej ,jk,jl,jf) = ARRAY_IN(nlei,nldj:nlej,jk,jl,jf)
101	ARRAY_IN(ji,1 :nldj-1,jk,jl,jf) = ARRAY_IN(nlei,nldj ,jk,jl,jf)
102	ARRAY_IN(ji,nlej+1:jpj ,jk,jl,jf) = ARRAY_IN(nlei, nlej,jk,jl,jf)
103	END DO
104	END DO
105	END DO
106	!
107	END DO
108	!
109	ELSE !== standard close or cyclic treatment ==!
110	!
111	DO jf = 1, ipf ! number of arrays to be treated
112	!
113	! ! East-West boundaries
114	IF( ll_Iperio ) THEN !* cyclic
115	ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
116	ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN( 2 ,:,:,:,jf)
117	ELSE !* closed
118	IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN( 1 :nn_hls,:,:,:,jf) = zland ! east except F-point
119	ARRAY_IN(nlci-nn_hls+1:jpi ,:,:,:,jf) = zland ! west
120	ENDIF
121	! ! North-South boundaries
122	IF( ll_Jperio ) THEN !* cyclic (only with no mpp j-split)
123	ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
124	ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:, 2 ,:,:,jf)
125	ELSE !* closed
126	IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(:, 1 :nn_hls,:,:,jf) = zland ! south except F-point
127	ARRAY_IN(:,nlcj-nn_hls+1:jpj ,:,:,jf) = zland ! north
128	ENDIF
129	END DO
130	!
131	ENDIF
132
133	! ------------------------------- !
134	! East and west exchange !
135	! ------------------------------- !
136	! we play with the neigbours AND the row number because of the periodicity
137	!
138	SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions
139	CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case)
140	iihom = nlci-nreci
141	DO jf = 1, ipf
142	DO jl = 1, ipl
143	DO jk = 1, ipk
144	DO jh = 1, nn_hls
145	zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
146	zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
147	END DO
148	END DO
149	END DO
150	END DO
151	END SELECT
152	!
153	! ! Migrations
154	imigr = nn_hls * jpj * ipk * ipl * ipf
155	!
156	SELECT CASE ( nbondi )
157	CASE ( -1 )
158	CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
159	CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
160	IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
161	CASE ( 0 )
162	CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
163	CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
164	CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
165	CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
166	IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
167	IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
168	CASE ( 1 )
169	CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
170	CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
171	IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
172	END SELECT
173	!
174	! ! Write Dirichlet lateral conditions
175	iihom = nlci-nn_hls
176	!
177	SELECT CASE ( nbondi )
178	CASE ( -1 )
179	DO jf = 1, ipf
180	DO jl = 1, ipl
181	DO jk = 1, ipk
182	DO jh = 1, nn_hls
183	ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
184	END DO
185	END DO
186	END DO
187	END DO
188	CASE ( 0 )
189	DO jf = 1, ipf
190	DO jl = 1, ipl
191	DO jk = 1, ipk
192	DO jh = 1, nn_hls
193	ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
194	ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
195	END DO
196	END DO
197	END DO
198	END DO
199	CASE ( 1 )
200	DO jf = 1, ipf
201	DO jl = 1, ipl
202	DO jk = 1, ipk
203	DO jh = 1, nn_hls
204	ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
205	END DO
206	END DO
207	END DO
208	END DO
209	END SELECT
210
211	! 3. North and south directions
212	! -----------------------------
213	! always closed : we play only with the neigbours
214	!
215	IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions
216	ijhom = nlcj-nrecj
217	DO jf = 1, ipf
218	DO jl = 1, ipl
219	DO jk = 1, ipk
220	DO jh = 1, nn_hls
221	zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
222	zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
223	END DO
224	END DO
225	END DO
226	END DO
227	ENDIF
228	!
229	! ! Migrations
230	imigr = nn_hls * jpi * ipk * ipl * ipf
231	!
232	SELECT CASE ( nbondj )
233	CASE ( -1 )
234	CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
235	CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
236	IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
237	CASE ( 0 )
238	CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
239	CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
240	CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
241	CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
242	IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
243	IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err )
244	CASE ( 1 )
245	CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
246	CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
247	IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
248	END SELECT
249	!
250	! ! Write Dirichlet lateral conditions
251	ijhom = nlcj-nn_hls
252	!
253	SELECT CASE ( nbondj )
254	CASE ( -1 )
255	DO jf = 1, ipf
256	DO jl = 1, ipl
257	DO jk = 1, ipk
258	DO jh = 1, nn_hls
259	ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
260	END DO
261	END DO
262	END DO
263	END DO
264	CASE ( 0 )
265	DO jf = 1, ipf
266	DO jl = 1, ipl
267	DO jk = 1, ipk
268	DO jh = 1, nn_hls
269	ARRAY_IN(:, jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
270	ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
271	END DO
272	END DO
273	END DO
274	END DO
275	CASE ( 1 )
276	DO jf = 1, ipf
277	DO jl = 1, ipl
278	DO jk = 1, ipk
279	DO jh = 1, nn_hls
280	ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
281	END DO
282	END DO
283	END DO
284	END DO
285	END SELECT
286
287	! 4. north fold treatment
288	! -----------------------
289	!
290	IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
291	!
292	SELECT CASE ( jpni )
293	CASE ( 1 ) ; CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) ) ! only 1 northern proc, no mpp
294	CASE DEFAULT ; CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) ) ! for all northern procs.
295	END SELECT
296	!
297	ENDIF
298	!
299	DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
300	!
301	END SUBROUTINE ROUTINE_LNK
302
303	#undef ARRAY_TYPE
304	#undef NAT_IN
305	#undef SGN_IN
306	#undef ARRAY_IN
307	#undef K_SIZE
308	#undef L_SIZE
309	#undef F_SIZE
310	#undef OPT_K

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

Download in other formats:

Original Format

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

Context Navigation

source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_lnk_generic.h90 @ 8809

Download in other formats: