Context Navigation

mpp_bdy_generic.h90 @ 8758

Last change on this file since 8758 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.5 KB

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

Download in other formats: