Context Navigation

mod_hallo.F90 @ 5155

Last change on this file since 5155 was 5128, checked in by abarral, 16 months ago
Correct bug in vlspltqs_loc.f90 from r2270 where we call SSUM with incorrect arguments. Merge the three different versions of abort_gcm into one Fix seq, para 3D compilation broken from r5107 onwards (lint) usual + Remove uneeded fixed-form continuations
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 53.8 KB

Line
1	module mod_Hallo
2	USE parallel_lmdz
3	IMPLICIT NONE
4	logical,save :: use_mpi_alloc
5	INTEGER, parameter :: MaxProc=512
6	INTEGER, parameter :: DefaultMaxBufferSize=10241024100
7	INTEGER, SAVE :: MaxBufferSize=0
8	INTEGER, parameter :: ListSize=1000
9
10	INTEGER,save :: MaxBufferSize_Used
11	!$OMP THREADPRIVATE( MaxBufferSize_Used)
12
13	REAL,SAVE,pointer,DIMENSION(:) :: Buffer
14	!$OMP THREADPRIVATE(Buffer)
15
16	INTEGER,SAVE,DIMENSION(Listsize) :: Buffer_Pos
17	INTEGER,save :: Index_Pos
18	!$OMP THREADPRIVATE(Buffer_Pos,Index_pos)
19
20	type Hallo
21	REAL, DIMENSION(:,:),pointer :: Field
22	INTEGER :: offset
23	INTEGER :: size
24	INTEGER :: NbLevel
25	INTEGER :: Stride
26	end type Hallo
27
28	type request_SR
29	INTEGER :: NbRequest=0
30	INTEGER :: NbRequestMax=0
31	INTEGER :: BufferSize
32	INTEGER :: Pos
33	INTEGER :: Index
34	type(Hallo), POINTER :: Hallo(:)
35	INTEGER :: MSG_Request
36	end type request_SR
37
38	type request
39	type(request_SR),DIMENSION(0:MaxProc-1) :: RequestSend
40	type(request_SR),DIMENSION(0:MaxProc-1) :: RequestRecv
41	INTEGER :: tag=1
42	end type request
43
44	TYPE(distrib),SAVE :: distrib_gather
45
46
47	INTERFACE Register_SwapField_u
48	MODULE PROCEDURE Register_SwapField1d_u,Register_SwapField2d_u1d,Register_SwapField3d_u, &
49	Register_SwapField1d_u_bis,Register_SwapField2d_u1d_bis,Register_SwapField3d_u_bis
50	END INTERFACE Register_SwapField_u
51
52	INTERFACE Register_SwapField_v
53	MODULE PROCEDURE Register_SwapField1d_v,Register_SwapField2d_v1d,Register_SwapField3d_v,&
54	Register_SwapField1d_v_bis,Register_SwapField2d_v1d_bis,Register_SwapField3d_v_bis
55	END INTERFACE Register_SwapField_v
56
57	INTERFACE Register_SwapField2d_u
58	MODULE PROCEDURE Register_SwapField1d_u2d,Register_SwapField2d_u2d,Register_SwapField3d_u2d, &
59	Register_SwapField1d_u2d_bis,Register_SwapField2d_u2d_bis,Register_SwapField3d_u2d_bis
60	END INTERFACE Register_SwapField2d_u
61
62	INTERFACE Register_SwapField2d_v
63	MODULE PROCEDURE Register_SwapField1d_v2d,Register_SwapField2d_v2d,Register_SwapField3d_v2d, &
64	Register_SwapField1d_v2d_bis,Register_SwapField2d_v2d_bis,Register_SwapField3d_v2d_bis
65	END INTERFACE Register_SwapField2d_v
66
67	CONTAINS
68
69	SUBROUTINE Init_mod_hallo
70	USE dimensions_mod
71	USE IOIPSL
72	IMPLICIT NONE
73	INTEGER :: jj_nb_gather(0:mpi_size-1)
74
75	Index_Pos=1
76	Buffer_Pos(Index_Pos)=1
77	MaxBufferSize_Used=0
78	!$OMP MASTER
79	MaxBufferSize=DefaultMaxBufferSize
80	CALL getin("mpi_buffer_size",MaxBufferSize)
81	!$OMP END MASTER
82	!$OMP BARRIER
83
84	IF (use_mpi_alloc .AND. using_mpi) THEN
85	CALL create_global_mpi_buffer
86	ELSE
87	CALL create_standard_mpi_buffer
88	ENDIF
89
90	!$OMP MASTER
91	jj_nb_gather(:)=0
92	jj_nb_gather(0)=jjp1
93
94	CALL create_distrib(jj_nb_gather,distrib_gather)
95	!$OMP END MASTER
96	!$OMP BARRIER
97
98	END SUBROUTINE init_mod_hallo
99
100	SUBROUTINE create_standard_mpi_buffer
101	IMPLICIT NONE
102
103	ALLOCATE(Buffer(MaxBufferSize))
104
105	END SUBROUTINE create_standard_mpi_buffer
106
107	SUBROUTINE create_global_mpi_buffer
108	USE lmdz_mpi
109	IMPLICIT NONE
110	POINTER (Pbuffer,MPI_Buffer(MaxBufferSize))
111	REAL :: MPI_Buffer
112	INTEGER(KIND=MPI_ADDRESS_KIND) :: BS
113	INTEGER :: i,ierr
114
115	! Allocation du buffer MPI
116	Bs=8*MaxBufferSize
117	!$OMP CRITICAL (MPI)
118	CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
119	!$OMP END CRITICAL (MPI)
120	DO i=1,MaxBufferSize
121	MPI_Buffer(i)=i
122	ENDDO
123
124	CALL Associate_buffer(MPI_Buffer)
125
126	CONTAINS
127
128	SUBROUTINE Associate_buffer(MPI_Buffer)
129	IMPLICIT NONE
130	REAL,DIMENSION(:),target :: MPI_Buffer
131
132	Buffer=>MPI_Buffer
133
134	END SUBROUTINE Associate_buffer
135
136	END SUBROUTINE create_global_mpi_buffer
137
138
139	SUBROUTINE allocate_buffer(Size,Index,Pos)
140
141	IMPLICIT NONE
142	INTEGER :: Size
143	INTEGER :: Index
144	INTEGER :: Pos
145
146	IF (Buffer_pos(Index_pos)+Size>MaxBufferSize_Used) MaxBufferSize_Used=Buffer_pos(Index_pos)+Size
147	IF (Buffer_pos(Index_pos)+Size>MaxBufferSize) THEN
148	print *,'STOP :: La taille de MaxBufferSize dans mod_hallo.F90 est trop petite !!!!'
149	CALL abort_gcm("mod_hallo","stopped",1)
150	endif
151
152	IF (Index_pos>=ListSize) THEN
153	print *,'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
154	CALL abort_gcm("mod_hallo","stopped",1)
155	endif
156
157	Pos=Buffer_Pos(Index_Pos)
158	Buffer_Pos(Index_pos+1)=Buffer_Pos(Index_Pos)+Size
159	Index_Pos=Index_Pos+1
160	Index=Index_Pos
161
162	END SUBROUTINE allocate_buffer
163
164	SUBROUTINE deallocate_buffer(Index)
165	IMPLICIT NONE
166	INTEGER :: Index
167
168	Buffer_Pos(Index)=-1
169
170	do while (Buffer_Pos(Index_Pos)==-1 .AND. Index_Pos>1)
171	Index_Pos=Index_Pos-1
172	END DO
173
174	END SUBROUTINE deallocate_buffer
175
176	SUBROUTINE SetTag(a_request,tag)
177	IMPLICIT NONE
178	type(request):: a_request
179	INTEGER :: tag
180
181	a_request%tag=tag
182	END SUBROUTINE SetTag
183
184
185	SUBROUTINE New_Hallo(Field,Stride,NbLevel,offset,size,Ptr_request)
186	INTEGER :: Stride
187	INTEGER :: NbLevel
188	INTEGER :: size
189	INTEGER :: offset
190	REAL, DIMENSION(Stride,NbLevel),target :: Field
191	type(request_SR),pointer :: Ptr_request
192	type(Hallo),POINTER :: NewHallos(:),HalloSwitch(:), NewHallo
193
194	Ptr_Request%NbRequest=Ptr_Request%NbRequest+1
195	IF(Ptr_Request%NbRequestMax==0) THEN
196	Ptr_Request%NbRequestMax=10
197	ALLOCATE(Ptr_Request%Hallo(Ptr_Request%NbRequestMax))
198	ELSE IF ( Ptr_Request%NbRequest > Ptr_Request%NbRequestMax) THEN
199	Ptr_Request%NbRequestMax=INT(Ptr_Request%NbRequestMax*1.2)
200	ALLOCATE(NewHallos(Ptr_Request%NbRequestMax))
201	NewHallos(1:Ptr_Request%NbRequest-1)=Ptr_Request%hallo(1:Ptr_Request%NbRequest-1)
202	HalloSwitch=>Ptr_Request%hallo
203	Ptr_Request%hallo=>NewHallos
204	DEALLOCATE(HalloSwitch)
205	ENDIF
206
207	NewHallo=>Ptr_Request%hallo(Ptr_Request%NbRequest)
208
209	NewHallo%Field=>Field
210	NewHallo%Stride=Stride
211	NewHallo%NbLevel=NbLevel
212	NewHallo%size=size
213	NewHallo%offset=offset
214
215	END SUBROUTINE New_Hallo
216
217	SUBROUTINE Register_SendField(Field,ij,ll,offset,size,target,a_request)
218	USE dimensions_mod
219	IMPLICIT NONE
220
221
222	INTEGER :: ij,ll,offset,size,target
223	REAL, DIMENSION(ij,ll) :: Field
224	type(request),target :: a_request
225	type(request_SR),pointer :: Ptr_request
226
227	Ptr_Request=>a_request%RequestSend(target)
228
229	CALL New_Hallo(Field,ij,ll,offset,size,Ptr_request)
230
231	END SUBROUTINE Register_SendField
232
233	SUBROUTINE Register_RecvField(Field,ij,ll,offset,size,target,a_request)
234	USE dimensions_mod
235	IMPLICIT NONE
236
237
238	INTEGER :: ij,ll,offset,size,target
239	REAL, DIMENSION(ij,ll) :: Field
240	type(request),target :: a_request
241	type(request_SR),pointer :: Ptr_request
242
243	Ptr_Request=>a_request%RequestRecv(target)
244
245	CALL New_Hallo(Field,ij,ll,offset,size,Ptr_request)
246
247
248	END SUBROUTINE Register_RecvField
249
250	SUBROUTINE Register_SwapField(FieldS,FieldR,ij,ll,jj_Nb_New,a_request)
251	USE dimensions_mod
252	IMPLICIT NONE
253
254
255	INTEGER :: ij,ll
256	REAL, DIMENSION(ij,ll) :: FieldS
257	REAL, DIMENSION(ij,ll) :: FieldR
258	type(request) :: a_request
259	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
260	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
261
262	INTEGER ::i,jje,jjb
263
264	jj_begin_New(0)=1
265	jj_End_New(0)=jj_Nb_New(0)
266	do i=1,MPI_Size-1
267	jj_begin_New(i)=jj_end_New(i-1)+1
268	jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
269	enddo
270
271	do i=0,MPI_Size-1
272	IF (i /= MPI_Rank) THEN
273	jjb=max(jj_begin_new(i),jj_begin)
274	jje=min(jj_end_new(i),jj_end)
275
276	IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
277
278	IF (jje >= jjb) THEN
279	CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
280	endif
281
282	jjb=max(jj_begin_new(MPI_Rank),jj_begin_Para(i))
283	jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
284
285	IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
286
287	IF (jje >= jjb) THEN
288	CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
289	endif
290
291	endif
292	enddo
293
294	END SUBROUTINE Register_SwapField
295
296
297
298	SUBROUTINE Register_SwapFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down,a_request)
299	USE dimensions_mod
300
301	IMPLICIT NONE
302
303	INTEGER :: ij,ll,Up,Down
304	REAL, DIMENSION(ij,ll) :: FieldS
305	REAL, DIMENSION(ij,ll) :: FieldR
306	type(request) :: a_request
307	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
308	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
309
310	INTEGER ::i,jje,jjb
311
312	jj_begin_New(0)=1
313	jj_End_New(0)=jj_Nb_New(0)
314	do i=1,MPI_Size-1
315	jj_begin_New(i)=jj_end_New(i-1)+1
316	jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
317	enddo
318
319	do i=0,MPI_Size-1
320	jj_begin_New(i)=max(1,jj_begin_New(i)-Up)
321	jj_end_New(i)=min(jjp1,jj_end_new(i)+Down)
322	enddo
323
324	do i=0,MPI_Size-1
325	IF (i /= MPI_Rank) THEN
326	jjb=max(jj_begin_new(i),jj_begin)
327	jje=min(jj_end_new(i),jj_end)
328
329	IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
330
331	IF (jje >= jjb) THEN
332	CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
333	endif
334
335	jjb=max(jj_begin_new(MPI_Rank),jj_begin_Para(i))
336	jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
337
338	IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
339
340	IF (jje >= jjb) THEN
341	CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
342	endif
343
344	endif
345	enddo
346
347	END SUBROUTINE Register_SwapFieldHallo
348
349
350
351	SUBROUTINE Register_SwapField1d_u(FieldS,FieldR,new_dist,a_request,up,down)
352	USE parallel_lmdz
353	USE dimensions_mod
354	IMPLICIT NONE
355
356	TYPE(distrib),INTENT(IN) :: new_dist
357	REAL, DIMENSION(current_dist%ijb_u:),INTENT(IN) :: FieldS
358	REAL, DIMENSION(new_dist%ijb_u:),INTENT(OUT) :: FieldR
359	INTEGER,OPTIONAL,INTENT(IN) :: up
360	INTEGER,OPTIONAL,INTENT(IN) :: down
361	TYPE(request),INTENT(INOUT) :: a_request
362
363	INTEGER :: halo_up
364	INTEGER :: halo_down
365
366
367	halo_up=0
368	halo_down=0
369	IF (PRESENT(up)) halo_up=up
370	IF (PRESENT(down)) halo_down=down
371
372	CALL Register_SwapField_gen_u(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
373
374	END SUBROUTINE Register_SwapField1d_u
375
376	SUBROUTINE Register_SwapField1d_u_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
377	USE parallel_lmdz
378	USE dimensions_mod
379	IMPLICIT NONE
380
381	TYPE(distrib),INTENT(IN) :: new_dist
382	TYPE(distrib),INTENT(IN) :: old_dist
383	REAL, DIMENSION(old_dist%ijb_u:),INTENT(IN) :: FieldS
384	REAL, DIMENSION(new_dist%ijb_u:),INTENT(OUT) :: FieldR
385	INTEGER,OPTIONAL,INTENT(IN) :: up
386	INTEGER,OPTIONAL,INTENT(IN) :: down
387	TYPE(request),INTENT(INOUT) :: a_request
388
389	INTEGER :: halo_up
390	INTEGER :: halo_down
391
392
393	halo_up=0
394	halo_down=0
395	IF (PRESENT(up)) halo_up=up
396	IF (PRESENT(down)) halo_down=down
397
398	CALL Register_SwapField_gen_u(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
399
400	END SUBROUTINE Register_SwapField1d_u_bis
401
402
403	SUBROUTINE Register_SwapField2d_u1d(FieldS,FieldR,new_dist,a_request,up,down)
404	USE parallel_lmdz
405	USE dimensions_mod
406	IMPLICIT NONE
407
408	TYPE(distrib),INTENT(IN) :: new_dist
409	REAL, DIMENSION(current_dist%ijb_u:,:),INTENT(IN) :: FieldS
410	REAL, DIMENSION(new_dist%ijb_u:,:),INTENT(OUT) :: FieldR
411	INTEGER,OPTIONAL,INTENT(IN) :: up
412	INTEGER,OPTIONAL,INTENT(IN) :: down
413	TYPE(request),INTENT(INOUT) :: a_request
414
415	INTEGER :: halo_up
416	INTEGER :: halo_down
417	INTEGER :: ll
418
419
420	halo_up=0
421	halo_down=0
422	IF (PRESENT(up)) halo_up=up
423	IF (PRESENT(down)) halo_down=down
424
425	ll=size(FieldS,2)
426
427	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
428
429	END SUBROUTINE Register_SwapField2d_u1d
430
431	SUBROUTINE Register_SwapField2d_u1d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
432	USE parallel_lmdz
433	USE dimensions_mod
434	IMPLICIT NONE
435
436	TYPE(distrib),INTENT(IN) :: new_dist
437	TYPE(distrib),INTENT(IN) :: old_dist
438	REAL, DIMENSION(old_dist%ijb_u:,:),INTENT(IN) :: FieldS
439	REAL, DIMENSION(new_dist%ijb_u:,:),INTENT(OUT) :: FieldR
440	INTEGER,OPTIONAL,INTENT(IN) :: up
441	INTEGER,OPTIONAL,INTENT(IN) :: down
442	TYPE(request),INTENT(INOUT) :: a_request
443
444	INTEGER :: halo_up
445	INTEGER :: halo_down
446	INTEGER :: ll
447
448
449	halo_up=0
450	halo_down=0
451	IF (PRESENT(up)) halo_up=up
452	IF (PRESENT(down)) halo_down=down
453
454	ll=size(FieldS,2)
455
456	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
457
458	END SUBROUTINE Register_SwapField2d_u1d_bis
459
460
461	SUBROUTINE Register_SwapField3d_u(FieldS,FieldR,new_dist,a_request,up,down)
462	USE parallel_lmdz
463	USE dimensions_mod
464	IMPLICIT NONE
465
466	TYPE(distrib),INTENT(IN) :: new_dist
467	REAL, DIMENSION(current_dist%ijb_u:,:,:),INTENT(IN) :: FieldS
468	REAL, DIMENSION(new_dist%ijb_u:,:,:),INTENT(OUT) :: FieldR
469	INTEGER,OPTIONAL,INTENT(IN) :: up
470	INTEGER,OPTIONAL,INTENT(IN) :: down
471	TYPE(request),INTENT(INOUT) :: a_request
472
473	INTEGER :: halo_up
474	INTEGER :: halo_down
475	INTEGER :: ll
476
477
478	halo_up=0
479	halo_down=0
480	IF (PRESENT(up)) halo_up=up
481	IF (PRESENT(down)) halo_down=down
482
483	ll=size(FieldS,2)*size(FieldS,3)
484
485	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
486
487	END SUBROUTINE Register_SwapField3d_u
488
489	SUBROUTINE Register_SwapField3d_u_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
490	USE parallel_lmdz
491	USE dimensions_mod
492	IMPLICIT NONE
493
494	TYPE(distrib),INTENT(IN) :: new_dist
495	TYPE(distrib),INTENT(IN) :: old_dist
496	REAL, DIMENSION(old_dist%ijb_u:,:,:),INTENT(IN) :: FieldS
497	REAL, DIMENSION(new_dist%ijb_u:,:,:),INTENT(OUT) :: FieldR
498	INTEGER,OPTIONAL,INTENT(IN) :: up
499	INTEGER,OPTIONAL,INTENT(IN) :: down
500	TYPE(request),INTENT(INOUT) :: a_request
501
502	INTEGER :: halo_up
503	INTEGER :: halo_down
504	INTEGER :: ll
505
506
507	halo_up=0
508	halo_down=0
509	IF (PRESENT(up)) halo_up=up
510	IF (PRESENT(down)) halo_down=down
511
512	ll=size(FieldS,2)*size(FieldS,3)
513
514	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
515
516	END SUBROUTINE Register_SwapField3d_u_bis
517
518
519
520	SUBROUTINE Register_SwapField1d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
521	USE parallel_lmdz
522	USE dimensions_mod
523
524	IMPLICIT NONE
525
526	TYPE(distrib),INTENT(IN) :: new_dist !LF
527	REAL, DIMENSION(current_dist%jjb_u:,:),INTENT(IN) :: FieldS
528	REAL, DIMENSION(new_dist%jjb_u:,:),INTENT(OUT) :: FieldR
529	INTEGER,OPTIONAL,INTENT(IN) :: up
530	INTEGER,OPTIONAL,INTENT(IN) :: down
531	TYPE(request),INTENT(INOUT) :: a_request
532
533	INTEGER :: halo_up
534	INTEGER :: halo_down
535
536
537	halo_up=0
538	halo_down=0
539	IF (PRESENT(up)) halo_up=up
540	IF (PRESENT(down)) halo_down=down
541
542	CALL Register_SwapField_gen_u(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
543
544	END SUBROUTINE Register_SwapField1d_u2d
545
546	SUBROUTINE Register_SwapField1d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
547	USE parallel_lmdz
548	USE dimensions_mod
549
550	IMPLICIT NONE
551
552	TYPE(distrib),INTENT(IN) :: new_dist !LF
553	TYPE(distrib),INTENT(IN) :: old_dist
554	REAL, DIMENSION(old_dist%jjb_u:,:),INTENT(IN) :: FieldS
555	REAL, DIMENSION(new_dist%jjb_u:,:),INTENT(OUT) :: FieldR
556	INTEGER,OPTIONAL,INTENT(IN) :: up
557	INTEGER,OPTIONAL,INTENT(IN) :: down
558	TYPE(request),INTENT(INOUT) :: a_request
559
560	INTEGER :: halo_up
561	INTEGER :: halo_down
562
563
564	halo_up=0
565	halo_down=0
566	IF (PRESENT(up)) halo_up=up
567	IF (PRESENT(down)) halo_down=down
568
569	CALL Register_SwapField_gen_u(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
570
571	END SUBROUTINE Register_SwapField1d_u2d_bis
572
573
574	SUBROUTINE Register_SwapField2d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
575	USE parallel_lmdz
576	USE dimensions_mod
577
578	IMPLICIT NONE
579
580	TYPE(distrib),INTENT(IN) :: new_dist
581	REAL, DIMENSION(current_dist%jjb_u:,:,:),INTENT(IN) :: FieldS
582	REAL, DIMENSION(new_dist%jjb_u:,:,:),INTENT(OUT) :: FieldR
583	INTEGER,OPTIONAL,INTENT(IN) :: up
584	INTEGER,OPTIONAL,INTENT(IN) :: down
585	TYPE(request),INTENT(INOUT) :: a_request
586
587	INTEGER :: halo_up
588	INTEGER :: halo_down
589	INTEGER :: ll
590
591
592	halo_up=0
593	halo_down=0
594	IF (PRESENT(up)) halo_up=up
595	IF (PRESENT(down)) halo_down=down
596
597	ll=size(FieldS,3)
598
599	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
600
601	END SUBROUTINE Register_SwapField2d_u2d
602
603	SUBROUTINE Register_SwapField2d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
604	USE parallel_lmdz
605	USE dimensions_mod
606
607	IMPLICIT NONE
608
609	TYPE(distrib),INTENT(IN) :: new_dist
610	TYPE(distrib),INTENT(IN) :: old_dist
611	REAL, DIMENSION(old_dist%jjb_u:,:,:),INTENT(IN) :: FieldS
612	REAL, DIMENSION(new_dist%jjb_u:,:,:),INTENT(OUT) :: FieldR
613	INTEGER,OPTIONAL,INTENT(IN) :: up
614	INTEGER,OPTIONAL,INTENT(IN) :: down
615	TYPE(request),INTENT(INOUT) :: a_request
616
617	INTEGER :: halo_up
618	INTEGER :: halo_down
619	INTEGER :: ll
620
621
622	halo_up=0
623	halo_down=0
624	IF (PRESENT(up)) halo_up=up
625	IF (PRESENT(down)) halo_down=down
626
627	ll=size(FieldS,3)
628
629	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
630
631	END SUBROUTINE Register_SwapField2d_u2d_bis
632
633
634	SUBROUTINE Register_SwapField3d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
635	USE parallel_lmdz
636	USE dimensions_mod
637	IMPLICIT NONE
638
639	TYPE(distrib),INTENT(IN) :: new_dist
640	REAL, DIMENSION(current_dist%jjb_u:,:,:,:),INTENT(IN) :: FieldS
641	REAL, DIMENSION(new_dist%jjb_u:,:,:,:),INTENT(OUT) :: FieldR
642	INTEGER,OPTIONAL,INTENT(IN) :: up
643	INTEGER,OPTIONAL,INTENT(IN) :: down
644	TYPE(request),INTENT(INOUT) :: a_request
645
646	INTEGER :: halo_up
647	INTEGER :: halo_down
648	INTEGER :: ll
649
650
651	halo_up=0
652	halo_down=0
653	IF (PRESENT(up)) halo_up=up
654	IF (PRESENT(down)) halo_down=down
655
656	ll=size(FieldS,3)*size(FieldS,4)
657
658	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
659
660	END SUBROUTINE Register_SwapField3d_u2d
661
662	SUBROUTINE Register_SwapField3d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
663	USE parallel_lmdz
664	USE dimensions_mod
665	IMPLICIT NONE
666
667	TYPE(distrib),INTENT(IN) :: new_dist
668	TYPE(distrib),INTENT(IN) :: old_dist
669	REAL, DIMENSION(old_dist%jjb_u:,:,:,:),INTENT(IN) :: FieldS
670	REAL, DIMENSION(new_dist%jjb_u:,:,:,:),INTENT(OUT) :: FieldR
671	INTEGER,OPTIONAL,INTENT(IN) :: up
672	INTEGER,OPTIONAL,INTENT(IN) :: down
673	TYPE(request),INTENT(INOUT) :: a_request
674
675	INTEGER :: halo_up
676	INTEGER :: halo_down
677	INTEGER :: ll
678
679
680	halo_up=0
681	halo_down=0
682	IF (PRESENT(up)) halo_up=up
683	IF (PRESENT(down)) halo_down=down
684
685	ll=size(FieldS,3)*size(FieldS,4)
686
687	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
688
689	END SUBROUTINE Register_SwapField3d_u2d_bis
690
691
692
693
694
695
696
697	SUBROUTINE Register_SwapField1d_v(FieldS,FieldR,new_dist,a_request,up,down)
698	USE parallel_lmdz
699	USE dimensions_mod
700	IMPLICIT NONE
701
702	TYPE(distrib),INTENT(IN) :: new_dist
703	REAL, DIMENSION(current_dist%ijb_v:),INTENT(IN) :: FieldS
704	REAL, DIMENSION(new_dist%ijb_v:),INTENT(OUT) :: FieldR
705	INTEGER,OPTIONAL,INTENT(IN) :: up
706	INTEGER,OPTIONAL,INTENT(IN) :: down
707	TYPE(request),INTENT(INOUT) :: a_request
708
709	INTEGER :: halo_up
710	INTEGER :: halo_down
711
712
713	halo_up=0
714	halo_down=0
715	IF (PRESENT(up)) halo_up=up
716	IF (PRESENT(down)) halo_down=down
717
718	CALL Register_SwapField_gen_v(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
719
720	END SUBROUTINE Register_SwapField1d_v
721
722	SUBROUTINE Register_SwapField1d_v_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
723	USE parallel_lmdz
724	USE dimensions_mod
725	IMPLICIT NONE
726
727	TYPE(distrib),INTENT(IN) :: new_dist
728	TYPE(distrib),INTENT(IN) :: old_dist
729	REAL, DIMENSION(old_dist%ijb_v:),INTENT(IN) :: FieldS
730	REAL, DIMENSION(new_dist%ijb_v:),INTENT(OUT) :: FieldR
731	INTEGER,OPTIONAL,INTENT(IN) :: up
732	INTEGER,OPTIONAL,INTENT(IN) :: down
733	TYPE(request),INTENT(INOUT) :: a_request
734
735	INTEGER :: halo_up
736	INTEGER :: halo_down
737
738
739	halo_up=0
740	halo_down=0
741	IF (PRESENT(up)) halo_up=up
742	IF (PRESENT(down)) halo_down=down
743
744	CALL Register_SwapField_gen_v(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
745
746	END SUBROUTINE Register_SwapField1d_v_bis
747
748
749	SUBROUTINE Register_SwapField2d_v1d(FieldS,FieldR,new_dist,a_request,up,down)
750	USE parallel_lmdz
751	USE dimensions_mod
752	IMPLICIT NONE
753
754	TYPE(distrib),INTENT(IN) :: new_dist
755	REAL, DIMENSION(current_dist%ijb_v:,:),INTENT(IN) :: FieldS
756	REAL, DIMENSION(new_dist%ijb_v:,:),INTENT(OUT) :: FieldR
757	INTEGER,OPTIONAL,INTENT(IN) :: up
758	INTEGER,OPTIONAL,INTENT(IN) :: down
759	TYPE(request),INTENT(INOUT) :: a_request
760
761	INTEGER :: halo_up
762	INTEGER :: halo_down
763	INTEGER :: ll
764
765
766	halo_up=0
767	halo_down=0
768	IF (PRESENT(up)) halo_up=up
769	IF (PRESENT(down)) halo_down=down
770
771	ll=size(FieldS,2)
772
773	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
774
775	END SUBROUTINE Register_SwapField2d_v1d
776
777	SUBROUTINE Register_SwapField2d_v1d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
778	USE parallel_lmdz
779	USE dimensions_mod
780	IMPLICIT NONE
781
782	TYPE(distrib),INTENT(IN) :: new_dist
783	TYPE(distrib),INTENT(IN) :: old_dist
784	REAL, DIMENSION(old_dist%ijb_v:,:),INTENT(IN) :: FieldS
785	REAL, DIMENSION(new_dist%ijb_v:,:),INTENT(OUT) :: FieldR
786	INTEGER,OPTIONAL,INTENT(IN) :: up
787	INTEGER,OPTIONAL,INTENT(IN) :: down
788	TYPE(request),INTENT(INOUT) :: a_request
789
790	INTEGER :: halo_up
791	INTEGER :: halo_down
792	INTEGER :: ll
793
794
795	halo_up=0
796	halo_down=0
797	IF (PRESENT(up)) halo_up=up
798	IF (PRESENT(down)) halo_down=down
799
800	ll=size(FieldS,2)
801
802	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
803
804	END SUBROUTINE Register_SwapField2d_v1d_bis
805
806
807
808	SUBROUTINE Register_SwapField3d_v(FieldS,FieldR,new_dist,a_request,up,down)
809	USE parallel_lmdz
810	USE dimensions_mod
811	IMPLICIT NONE
812
813	TYPE(distrib),INTENT(IN) :: new_dist
814	REAL, DIMENSION(current_dist%ijb_v:,:,:),INTENT(IN) :: FieldS
815	REAL, DIMENSION(new_dist%ijb_v:,:,:),INTENT(OUT) :: FieldR
816	INTEGER,OPTIONAL,INTENT(IN) :: up
817	INTEGER,OPTIONAL,INTENT(IN) :: down
818	TYPE(request),INTENT(INOUT) :: a_request
819
820	INTEGER :: halo_up
821	INTEGER :: halo_down
822	INTEGER :: ll
823
824
825	halo_up=0
826	halo_down=0
827	IF (PRESENT(up)) halo_up=up
828	IF (PRESENT(down)) halo_down=down
829
830	ll=size(FieldS,2)*size(FieldS,3)
831
832	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
833
834	END SUBROUTINE Register_SwapField3d_v
835
836	SUBROUTINE Register_SwapField3d_v_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
837	USE parallel_lmdz
838	USE dimensions_mod
839	IMPLICIT NONE
840
841	TYPE(distrib),INTENT(IN) :: new_dist
842	TYPE(distrib),INTENT(IN) :: old_dist
843	REAL, DIMENSION(old_dist%ijb_v:,:,:),INTENT(IN) :: FieldS
844	REAL, DIMENSION(new_dist%ijb_v:,:,:),INTENT(OUT) :: FieldR
845	INTEGER,OPTIONAL,INTENT(IN) :: up
846	INTEGER,OPTIONAL,INTENT(IN) :: down
847	TYPE(request),INTENT(INOUT) :: a_request
848
849	INTEGER :: halo_up
850	INTEGER :: halo_down
851	INTEGER :: ll
852
853
854	halo_up=0
855	halo_down=0
856	IF (PRESENT(up)) halo_up=up
857	IF (PRESENT(down)) halo_down=down
858
859	ll=size(FieldS,2)*size(FieldS,3)
860
861	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
862
863	END SUBROUTINE Register_SwapField3d_v_bis
864
865
866
867
868	SUBROUTINE Register_SwapField1d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
869	USE parallel_lmdz
870	USE dimensions_mod
871	IMPLICIT NONE
872
873	TYPE(distrib),INTENT(IN) :: new_dist !LF
874	REAL, DIMENSION(current_dist%jjb_v:,:),INTENT(IN) :: FieldS
875	REAL, DIMENSION(new_dist%jjb_v:,:),INTENT(OUT) :: FieldR
876	INTEGER,OPTIONAL,INTENT(IN) :: up
877	INTEGER,OPTIONAL,INTENT(IN) :: down
878	TYPE(request),INTENT(INOUT) :: a_request
879
880	INTEGER :: halo_up
881	INTEGER :: halo_down
882
883
884	halo_up=0
885	halo_down=0
886	IF (PRESENT(up)) halo_up=up
887	IF (PRESENT(down)) halo_down=down
888
889	CALL Register_SwapField_gen_v(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
890
891	END SUBROUTINE Register_SwapField1d_v2d
892
893	SUBROUTINE Register_SwapField1d_v2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
894	USE parallel_lmdz
895	USE dimensions_mod
896	IMPLICIT NONE
897
898	TYPE(distrib),INTENT(IN) :: new_dist !LF
899	TYPE(distrib),INTENT(IN) :: old_dist
900	REAL, DIMENSION(old_dist%jjb_v:,:),INTENT(IN) :: FieldS
901	REAL, DIMENSION(new_dist%jjb_v:,:),INTENT(OUT) :: FieldR
902	INTEGER,OPTIONAL,INTENT(IN) :: up
903	INTEGER,OPTIONAL,INTENT(IN) :: down
904	TYPE(request),INTENT(INOUT) :: a_request
905
906	INTEGER :: halo_up
907	INTEGER :: halo_down
908
909
910	halo_up=0
911	halo_down=0
912	IF (PRESENT(up)) halo_up=up
913	IF (PRESENT(down)) halo_down=down
914
915	CALL Register_SwapField_gen_v(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
916
917	END SUBROUTINE Register_SwapField1d_v2d_bis
918
919
920	SUBROUTINE Register_SwapField2d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
921	USE parallel_lmdz
922	USE dimensions_mod
923	IMPLICIT NONE
924
925	TYPE(distrib),INTENT(IN) :: new_dist
926	REAL, DIMENSION(current_dist%jjb_v:,:,:),INTENT(IN) :: FieldS
927	REAL, DIMENSION(new_dist%jjb_v:,:,:),INTENT(OUT) :: FieldR
928	INTEGER,OPTIONAL,INTENT(IN) :: up
929	INTEGER,OPTIONAL,INTENT(IN) :: down
930	TYPE(request),INTENT(INOUT) :: a_request
931
932	INTEGER :: halo_up
933	INTEGER :: halo_down
934	INTEGER :: ll
935
936
937	halo_up=0
938	halo_down=0
939	IF (PRESENT(up)) halo_up=up
940	IF (PRESENT(down)) halo_down=down
941
942	ll=size(FieldS,3)
943
944	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
945
946	END SUBROUTINE Register_SwapField2d_v2d
947
948	SUBROUTINE Register_SwapField2d_v2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
949	USE parallel_lmdz
950	USE dimensions_mod
951	IMPLICIT NONE
952
953	TYPE(distrib),INTENT(IN) :: new_dist
954	TYPE(distrib),INTENT(IN) :: old_dist
955	REAL, DIMENSION(old_dist%jjb_v:,:,:),INTENT(IN) :: FieldS
956	REAL, DIMENSION(new_dist%jjb_v:,:,:),INTENT(OUT) :: FieldR
957	INTEGER,OPTIONAL,INTENT(IN) :: up
958	INTEGER,OPTIONAL,INTENT(IN) :: down
959	TYPE(request),INTENT(INOUT) :: a_request
960
961	INTEGER :: halo_up
962	INTEGER :: halo_down
963	INTEGER :: ll
964
965
966	halo_up=0
967	halo_down=0
968	IF (PRESENT(up)) halo_up=up
969	IF (PRESENT(down)) halo_down=down
970
971	ll=size(FieldS,3)
972
973	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
974
975	END SUBROUTINE Register_SwapField2d_v2d_bis
976
977
978	SUBROUTINE Register_SwapField3d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
979	USE parallel_lmdz
980	USE dimensions_mod
981	IMPLICIT NONE
982
983	TYPE(distrib),INTENT(IN) :: new_dist
984	REAL, DIMENSION(current_dist%jjb_v:,:,:,:),INTENT(IN) :: FieldS
985	REAL, DIMENSION(new_dist%jjb_v:,:,:,:),INTENT(OUT) :: FieldR
986	INTEGER,OPTIONAL,INTENT(IN) :: up
987	INTEGER,OPTIONAL,INTENT(IN) :: down
988	TYPE(request),INTENT(INOUT) :: a_request
989
990	INTEGER :: halo_up
991	INTEGER :: halo_down
992	INTEGER :: ll
993
994
995	halo_up=0
996	halo_down=0
997	IF (PRESENT(up)) halo_up=up
998	IF (PRESENT(down)) halo_down=down
999
1000	ll=size(FieldS,3)*size(FieldS,4)
1001
1002	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
1003
1004	END SUBROUTINE Register_SwapField3d_v2d
1005
1006	SUBROUTINE Register_SwapField3d_v2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
1007	USE parallel_lmdz
1008	USE dimensions_mod
1009	IMPLICIT NONE
1010
1011	TYPE(distrib),INTENT(IN) :: new_dist
1012	TYPE(distrib),INTENT(IN) :: old_dist
1013	REAL, DIMENSION(old_dist%jjb_v:,:,:,:),INTENT(IN) :: FieldS
1014	REAL, DIMENSION(new_dist%jjb_v:,:,:,:),INTENT(OUT) :: FieldR
1015	INTEGER,OPTIONAL,INTENT(IN) :: up
1016	INTEGER,OPTIONAL,INTENT(IN) :: down
1017	TYPE(request),INTENT(INOUT) :: a_request
1018
1019	INTEGER :: halo_up
1020	INTEGER :: halo_down
1021	INTEGER :: ll
1022
1023
1024	halo_up=0
1025	halo_down=0
1026	IF (PRESENT(up)) halo_up=up
1027	IF (PRESENT(down)) halo_down=down
1028
1029	ll=size(FieldS,3)*size(FieldS,4)
1030
1031	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
1032
1033	END SUBROUTINE Register_SwapField3d_v2d_bis
1034
1035
1036
1037	SUBROUTINE Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,Up,Down,a_request)
1038	USE parallel_lmdz
1039	USE dimensions_mod
1040	IMPLICIT NONE
1041
1042	INTEGER :: ll,Up,Down
1043	TYPE(distrib) :: old_dist
1044	TYPE(distrib) :: new_dist
1045	REAL, DIMENSION(old_dist%ijb_u:old_dist%ije_u,ll) :: FieldS
1046	REAL, DIMENSION(new_dist%ijb_u:new_dist%ije_u,ll) :: FieldR
1047	TYPE(request) :: a_request
1048	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
1049	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
1050
1051	INTEGER ::i,l,jje,jjb,ijb,ije
1052
1053	DO i=0,MPI_Size-1
1054	jj_begin_New(i)=max(1,new_dist%jj_begin_para(i)-Up)
1055	jj_end_New(i)=min(jjp1,new_dist%jj_end_para(i)+Down)
1056	ENDDO
1057
1058	DO i=0,MPI_Size-1
1059	IF (i /= MPI_Rank) THEN
1060	jjb=max(jj_begin_new(i),old_dist%jj_begin)
1061	jje=min(jj_end_new(i),old_dist%jj_end)
1062
1063	IF (jje >= jjb) THEN
1064	CALL Register_SendField(FieldS,old_dist%ijnb_u,ll,jjb-old_dist%jjb_u+1,jje-jjb+1,i,a_request)
1065	ENDIF
1066
1067	jjb=max(jj_begin_new(MPI_Rank),old_dist%jj_begin_Para(i))
1068	jje=min(jj_end_new(MPI_Rank),old_dist%jj_end_Para(i))
1069
1070	IF (jje >= jjb) THEN
1071	CALL Register_RecvField(FieldR,new_dist%ijnb_u,ll,jjb-new_dist%jjb_u+1,jje-jjb+1,i,a_request)
1072	ENDIF
1073	ELSE
1074	jjb=max(jj_begin_new(i),old_dist%jj_begin)
1075	jje=min(jj_end_new(i),old_dist%jj_end)
1076	ijb=(jjb-1)*iip1+1
1077	ije=jje*iip1
1078	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1079	DO l=1,ll
1080	FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
1081	ENDDO
1082	!$OMP END DO NOWAIT
1083	ENDIF
1084	ENDDO
1085
1086	END SUBROUTINE Register_SwapField_gen_u
1087
1088
1089
1090	SUBROUTINE Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,Up,Down,a_request)
1091	USE parallel_lmdz
1092	USE dimensions_mod
1093	IMPLICIT NONE
1094
1095	INTEGER :: ll,Up,Down
1096	TYPE(distrib) :: old_dist
1097	TYPE(distrib) :: new_dist
1098	REAL, DIMENSION(old_dist%ijb_v:old_dist%ije_v,ll) :: FieldS
1099	REAL, DIMENSION(new_dist%ijb_v:new_dist%ije_v,ll) :: FieldR
1100	TYPE(request) :: a_request
1101	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
1102	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
1103
1104	INTEGER ::i,l,jje,jjb,ijb,ije
1105
1106	DO i=0,MPI_Size-1
1107	jj_begin_New(i)=max(1,new_dist%jj_begin_para(i)-Up)
1108	jj_end_New(i)=min(jjp1,new_dist%jj_end_para(i)+Down)
1109	ENDDO
1110
1111	DO i=0,MPI_Size-1
1112	IF (i /= MPI_Rank) THEN
1113	jjb=max(jj_begin_new(i),old_dist%jj_begin)
1114	jje=min(jj_end_new(i),old_dist%jj_end)
1115
1116	IF (jje==jjp1) jje=jjm
1117
1118	IF (jje >= jjb) THEN
1119	CALL Register_SendField(FieldS,old_dist%ijnb_v,ll,jjb-old_dist%jjb_v+1,jje-jjb+1,i,a_request)
1120	ENDIF
1121
1122	jjb=max(jj_begin_new(MPI_Rank),old_dist%jj_begin_Para(i))
1123	jje=min(jj_end_new(MPI_Rank),old_dist%jj_end_Para(i))
1124
1125	IF (jje==jjp1) jje=jjm
1126
1127	IF (jje >= jjb) THEN
1128	CALL Register_RecvField(FieldR,new_dist%ijnb_v,ll,jjb-new_dist%jjb_v+1,jje-jjb+1,i,a_request)
1129	ENDIF
1130	ELSE
1131	jjb=max(jj_begin_new(i),old_dist%jj_begin)
1132	jje=min(jj_end_new(i),old_dist%jj_end)
1133	IF (jje==jjp1) jje=jjm
1134	ijb=(jjb-1)*iip1+1
1135	ije=jje*iip1
1136	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1137	DO l=1,ll
1138	FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
1139	ENDDO
1140	!$OMP END DO NOWAIT
1141	ENDIF
1142	ENDDO
1143
1144	END SUBROUTINE Register_SwapField_gen_v
1145
1146
1147
1148
1149
1150	SUBROUTINE Register_Hallo(Field,ij,ll,RUp,Rdown,SUp,SDown,a_request)
1151	USE dimensions_mod
1152	USE lmdz_mpi
1153	IMPLICIT NONE
1154
1155	INTEGER :: ij,ll
1156	REAL, DIMENSION(ij,ll) :: Field
1157	INTEGER :: Sup,Sdown,rup,rdown
1158	type(request) :: a_request
1159	type(Hallo),pointer :: PtrHallo
1160	LOGICAL :: SendUp,SendDown
1161	LOGICAL :: RecvUp,RecvDown
1162
1163
1164	SendUp=.TRUE.
1165	SendDown=.TRUE.
1166	RecvUp=.TRUE.
1167	RecvDown=.TRUE.
1168
1169	IF (pole_nord) THEN
1170	SendUp=.FALSE.
1171	RecvUp=.FALSE.
1172	ENDIF
1173
1174	IF (pole_sud) THEN
1175	SendDown=.FALSE.
1176	RecvDown=.FALSE.
1177	ENDIF
1178
1179	IF (Sup==0) THEN
1180	SendUp=.FALSE.
1181	endif
1182
1183	IF (Sdown==0) THEN
1184	SendDown=.FALSE.
1185	endif
1186
1187	IF (Rup==0) THEN
1188	RecvUp=.FALSE.
1189	endif
1190
1191	IF (Rdown==0) THEN
1192	RecvDown=.FALSE.
1193	endif
1194
1195	IF (SendUp) THEN
1196	CALL Register_SendField(Field,ij,ll,jj_begin,SUp,MPI_Rank-1,a_request)
1197	ENDIF
1198
1199	IF (SendDown) THEN
1200	CALL Register_SendField(Field,ij,ll,jj_end-SDown+1,SDown,MPI_Rank+1,a_request)
1201	ENDIF
1202
1203
1204	IF (RecvUp) THEN
1205	CALL Register_RecvField(Field,ij,ll,jj_begin-Rup,RUp,MPI_Rank-1,a_request)
1206	ENDIF
1207
1208	IF (RecvDown) THEN
1209	CALL Register_RecvField(Field,ij,ll,jj_end+1,RDown,MPI_Rank+1,a_request)
1210	ENDIF
1211
1212	END SUBROUTINE Register_Hallo
1213
1214
1215	SUBROUTINE Register_Hallo_u(Field,ll,RUp,Rdown,SUp,SDown,a_request)
1216	USE dimensions_mod
1217	USE lmdz_mpi
1218	IMPLICIT NONE
1219	INTEGER :: ll
1220	REAL, DIMENSION(ijb_u:ije_u,ll) :: Field
1221	INTEGER :: Sup,Sdown,rup,rdown
1222	type(request) :: a_request
1223	type(Hallo),pointer :: PtrHallo
1224	LOGICAL :: SendUp,SendDown
1225	LOGICAL :: RecvUp,RecvDown
1226
1227
1228	SendUp=.TRUE.
1229	SendDown=.TRUE.
1230	RecvUp=.TRUE.
1231	RecvDown=.TRUE.
1232
1233	IF (pole_nord) THEN
1234	SendUp=.FALSE.
1235	RecvUp=.FALSE.
1236	ENDIF
1237
1238	IF (pole_sud) THEN
1239	SendDown=.FALSE.
1240	RecvDown=.FALSE.
1241	ENDIF
1242
1243	IF (Sup==0) THEN
1244	SendUp=.FALSE.
1245	endif
1246
1247	IF (Sdown==0) THEN
1248	SendDown=.FALSE.
1249	endif
1250
1251	IF (Rup==0) THEN
1252	RecvUp=.FALSE.
1253	endif
1254
1255	IF (Rdown==0) THEN
1256	RecvDown=.FALSE.
1257	endif
1258
1259	IF (SendUp) THEN
1260	CALL Register_SendField(Field,ijnb_u,ll,jj_begin-jjb_u+1,SUp,MPI_Rank-1,a_request)
1261	ENDIF
1262
1263	IF (SendDown) THEN
1264	CALL Register_SendField(Field,ijnb_u,ll,jj_end-SDown+1-jjb_u+1,SDown,MPI_Rank+1,a_request)
1265	ENDIF
1266
1267
1268	IF (RecvUp) THEN
1269	CALL Register_RecvField(Field,ijnb_u,ll,jj_begin-Rup-jjb_u+1,RUp,MPI_Rank-1,a_request)
1270	ENDIF
1271
1272	IF (RecvDown) THEN
1273	CALL Register_RecvField(Field,ijnb_u,ll,jj_end+1-jjb_u+1,RDown,MPI_Rank+1,a_request)
1274	ENDIF
1275
1276	END SUBROUTINE Register_Hallo_u
1277
1278	SUBROUTINE Register_Hallo_v(Field,ll,RUp,Rdown,SUp,SDown,a_request)
1279	USE dimensions_mod
1280	USE lmdz_mpi
1281	IMPLICIT NONE
1282	INTEGER :: ll
1283	REAL, DIMENSION(ijb_v:ije_v,ll) :: Field
1284	INTEGER :: Sup,Sdown,rup,rdown
1285	type(request) :: a_request
1286	type(Hallo),pointer :: PtrHallo
1287	LOGICAL :: SendUp,SendDown
1288	LOGICAL :: RecvUp,RecvDown
1289
1290
1291	SendUp=.TRUE.
1292	SendDown=.TRUE.
1293	RecvUp=.TRUE.
1294	RecvDown=.TRUE.
1295
1296	IF (pole_nord) THEN
1297	SendUp=.FALSE.
1298	RecvUp=.FALSE.
1299	ENDIF
1300
1301	IF (pole_sud) THEN
1302	SendDown=.FALSE.
1303	RecvDown=.FALSE.
1304	ENDIF
1305
1306	IF (Sup==0) THEN
1307	SendUp=.FALSE.
1308	endif
1309
1310	IF (Sdown==0) THEN
1311	SendDown=.FALSE.
1312	endif
1313
1314	IF (Rup==0) THEN
1315	RecvUp=.FALSE.
1316	endif
1317
1318	IF (Rdown==0) THEN
1319	RecvDown=.FALSE.
1320	endif
1321
1322	IF (SendUp) THEN
1323	CALL Register_SendField(Field,ijnb_v,ll,jj_begin-jjb_v+1,SUp,MPI_Rank-1,a_request)
1324	ENDIF
1325
1326	IF (SendDown) THEN
1327	CALL Register_SendField(Field,ijnb_v,ll,jj_end-SDown+1-jjb_v+1,SDown,MPI_Rank+1,a_request)
1328	ENDIF
1329
1330
1331	IF (RecvUp) THEN
1332	CALL Register_RecvField(Field,ijnb_v,ll,jj_begin-Rup-jjb_v+1,RUp,MPI_Rank-1,a_request)
1333	ENDIF
1334
1335	IF (RecvDown) THEN
1336	CALL Register_RecvField(Field,ijnb_v,ll,jj_end+1-jjb_v+1,RDown,MPI_Rank+1,a_request)
1337	ENDIF
1338
1339	END SUBROUTINE Register_Hallo_v
1340
1341	SUBROUTINE SendRequest(a_Request)
1342	USE dimensions_mod
1343	USE lmdz_mpi
1344	IMPLICIT NONE
1345
1346	type(request),target :: a_request
1347	type(request_SR),pointer :: Req
1348	type(Hallo),pointer :: PtrHallo
1349	INTEGER :: SizeBuffer
1350	INTEGER :: i,rank,l,ij,Pos,ierr
1351	INTEGER :: offset
1352	REAL,DIMENSION(:,:),pointer :: Field
1353	INTEGER :: Nb
1354
1355	do rank=0,MPI_SIZE-1
1356
1357	Req=>a_Request%RequestSend(rank)
1358
1359	SizeBuffer=0
1360	do i=1,Req%NbRequest
1361	PtrHallo=>Req%Hallo(i)
1362	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1363	DO l=1,PtrHallo%NbLevel
1364	SizeBuffer=SizeBuffer+PtrHallo%size*iip1
1365	ENDDO
1366	!$OMP ENDDO NOWAIT
1367	enddo
1368
1369	Req%BufferSize=SizeBuffer
1370	IF (Req%NbRequest>0) THEN
1371	CALL allocate_buffer(SizeBuffer,Req%Index,Req%pos)
1372
1373	Pos=Req%Pos
1374	do i=1,Req%NbRequest
1375	PtrHallo=>Req%Hallo(i)
1376	offset=(PtrHallo%offset-1)*iip1+1
1377	Nb=iip1*PtrHallo%size-1
1378	Field=>PtrHallo%Field
1379
1380	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1381	do l=1,PtrHallo%NbLevel
1382	!cdir NODEP
1383	do ij=0,Nb
1384	Buffer(Pos+ij)=Field(Offset+ij,l)
1385	enddo
1386
1387	Pos=Pos+Nb+1
1388	enddo
1389	!$OMP END DO NOWAIT
1390	enddo
1391
1392	IF (SizeBuffer>0) THEN
1393	!$OMP CRITICAL (MPI)
1394
1395	CALL MPI_ISEND(Buffer(req%Pos),SizeBuffer,MPI_REAL_LMDZ,rank,a_request%tag+1000*omp_rank, &
1396	COMM_LMDZ,Req%MSG_Request,ierr)
1397	IF (.NOT.using_mpi) THEN
1398	PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
1399	CALL abort_gcm("mod_hallo","stopped",1)
1400	ENDIF
1401	! PRINT *,"-------------------------------------------------------------------"
1402	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
1403	! PRINT ,"Requete envoye au proc :",rank,"tag :",a_request%tag+1000omp_rank
1404	! PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
1405	! PRINT *,"-------------------------------------------------------------------"
1406	!$OMP END CRITICAL (MPI)
1407	endif
1408	endif
1409	enddo
1410
1411
1412	do rank=0,MPI_SIZE-1
1413
1414	Req=>a_Request%RequestRecv(rank)
1415	SizeBuffer=0
1416
1417	do i=1,Req%NbRequest
1418	PtrHallo=>Req%Hallo(i)
1419
1420	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1421	DO l=1,PtrHallo%NbLevel
1422	SizeBuffer=SizeBuffer+PtrHallo%size*iip1
1423	ENDDO
1424	!$OMP ENDDO NOWAIT
1425	enddo
1426
1427	Req%BufferSize=SizeBuffer
1428
1429	IF (Req%NbRequest>0) THEN
1430	CALL allocate_buffer(SizeBuffer,Req%Index,Req%Pos)
1431
1432	IF (SizeBuffer>0) THEN
1433	!$OMP CRITICAL (MPI)
1434
1435	CALL MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL_LMDZ,rank,a_request%tag+1000*omp_rank, &
1436	COMM_LMDZ,Req%MSG_Request,ierr)
1437
1438	IF (.NOT.using_mpi) THEN
1439	PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
1440	CALL abort_gcm("mod_hallo","stopped",1)
1441	ENDIF
1442
1443	! PRINT *,"-------------------------------------------------------------------"
1444	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
1445	! PRINT ,"Requete en attente du proc :",rank,"tag :",a_request%tag+1000omp_rank
1446	! PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
1447	! PRINT *,"-------------------------------------------------------------------"
1448
1449	!$OMP END CRITICAL (MPI)
1450	endif
1451	endif
1452
1453	enddo
1454
1455	END SUBROUTINE SendRequest
1456
1457	SUBROUTINE WaitRequest(a_Request)
1458	USE dimensions_mod
1459	USE lmdz_mpi
1460	IMPLICIT NONE
1461
1462	type(request),target :: a_request
1463	type(request_SR),pointer :: Req
1464	type(Hallo),pointer :: PtrHallo
1465	INTEGER, DIMENSION(2*mpi_size) :: TabRequest
1466	INTEGER, DIMENSION(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
1467	INTEGER :: NbRequest
1468	INTEGER :: i,rank,pos,ij,l,ierr
1469	INTEGER :: offset
1470	INTEGER :: Nb
1471
1472
1473	NbRequest=0
1474	do rank=0,MPI_SIZE-1
1475	Req=>a_request%RequestSend(rank)
1476	IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
1477	NbRequest=NbRequest+1
1478	TabRequest(NbRequest)=Req%MSG_Request
1479	endif
1480	enddo
1481
1482	do rank=0,MPI_SIZE-1
1483	Req=>a_request%RequestRecv(rank)
1484	IF (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
1485	NbRequest=NbRequest+1
1486	TabRequest(NbRequest)=Req%MSG_Request
1487	endif
1488	enddo
1489
1490	IF (NbRequest>0) THEN
1491	!$OMP CRITICAL (MPI)
1492	! PRINT *,"-------------------------------------------------------------------"
1493	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
1494	! PRINT *,"No des requetes :",TabRequest(1:NbRequest)
1495	CALL MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
1496	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
1497	! PRINT *,"-------------------------------------------------------------------"
1498	!$OMP END CRITICAL (MPI)
1499	endif
1500	do rank=0,MPI_Size-1
1501	Req=>a_request%RequestRecv(rank)
1502	IF (Req%NbRequest>0) THEN
1503	Pos=Req%Pos
1504	do i=1,Req%NbRequest
1505	PtrHallo=>Req%Hallo(i)
1506	offset=(PtrHallo%offset-1)*iip1+1
1507	Nb=iip1*PtrHallo%size-1
1508
1509	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1510	do l=1,PtrHallo%NbLevel
1511	!cdir NODEP
1512	do ij=0,Nb
1513	PtrHallo%Field(offset+ij,l)=Buffer(Pos+ij)
1514	enddo
1515
1516	Pos=Pos+Nb+1
1517	enddo
1518	!$OMP ENDDO NOWAIT
1519	enddo
1520	endif
1521	enddo
1522
1523	do rank=0,MPI_SIZE-1
1524	Req=>a_request%RequestSend(rank)
1525	IF (Req%NbRequest>0) THEN
1526	CALL deallocate_buffer(Req%Index)
1527	Req%NbRequest=0
1528	endif
1529	enddo
1530
1531	do rank=0,MPI_SIZE-1
1532	Req=>a_request%RequestRecv(rank)
1533	IF (Req%NbRequest>0) THEN
1534	CALL deallocate_buffer(Req%Index)
1535	Req%NbRequest=0
1536	endif
1537	enddo
1538
1539	a_request%tag=1
1540	END SUBROUTINE WaitRequest
1541
1542	SUBROUTINE WaitSendRequest(a_Request)
1543	USE lmdz_mpi
1544	USE dimensions_mod
1545	IMPLICIT NONE
1546
1547	type(request),target :: a_request
1548	type(request_SR),pointer :: Req
1549	type(Hallo),pointer :: PtrHallo
1550	INTEGER, DIMENSION(mpi_size) :: TabRequest
1551	INTEGER, DIMENSION(MPI_STATUS_SIZE,mpi_size) :: TabStatus
1552	INTEGER :: NbRequest
1553	INTEGER :: i,rank,pos,ij,l,ierr
1554	INTEGER :: offset
1555
1556
1557	NbRequest=0
1558	do rank=0,MPI_SIZE-1
1559	Req=>a_request%RequestSend(rank)
1560	IF (Req%NbRequest>0) THEN
1561	NbRequest=NbRequest+1
1562	TabRequest(NbRequest)=Req%MSG_Request
1563	endif
1564	enddo
1565
1566
1567	IF (NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
1568	!$OMP CRITICAL (MPI)
1569	! PRINT *,"-------------------------------------------------------------------"
1570	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
1571	! PRINT *,"No des requetes :",TabRequest(1:NbRequest)
1572	CALL MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
1573	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
1574	! PRINT *,"-------------------------------------------------------------------"
1575
1576	!$OMP END CRITICAL (MPI)
1577	endif
1578
1579	do rank=0,MPI_SIZE-1
1580	Req=>a_request%RequestSend(rank)
1581	IF (Req%NbRequest>0) THEN
1582	CALL deallocate_buffer(Req%Index)
1583	Req%NbRequest=0
1584	endif
1585	enddo
1586
1587	a_request%tag=1
1588	END SUBROUTINE WaitSendRequest
1589
1590	SUBROUTINE WaitRecvRequest(a_Request)
1591	USE dimensions_mod
1592	USE lmdz_mpi
1593	IMPLICIT NONE
1594	type(request),target :: a_request
1595	type(request_SR),pointer :: Req
1596	type(Hallo),pointer :: PtrHallo
1597	INTEGER, DIMENSION(mpi_size) :: TabRequest
1598	INTEGER, DIMENSION(MPI_STATUS_SIZE,mpi_size) :: TabStatus
1599	INTEGER :: NbRequest
1600	INTEGER :: i,rank,pos,ij,l,ierr
1601	INTEGER :: offset,Nb
1602
1603
1604	NbRequest=0
1605
1606	do rank=0,MPI_SIZE-1
1607	Req=>a_request%RequestRecv(rank)
1608	IF (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
1609	NbRequest=NbRequest+1
1610	TabRequest(NbRequest)=Req%MSG_Request
1611	endif
1612	enddo
1613
1614
1615	IF (NbRequest>0) THEN
1616	!$OMP CRITICAL (MPI)
1617	! PRINT *,"-------------------------------------------------------------------"
1618	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
1619	! PRINT *,"No des requetes :",TabRequest(1:NbRequest)
1620	CALL MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
1621	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
1622	! PRINT *,"-------------------------------------------------------------------"
1623	!$OMP END CRITICAL (MPI)
1624	endif
1625
1626	do rank=0,MPI_Size-1
1627	Req=>a_request%RequestRecv(rank)
1628	IF (Req%NbRequest>0) THEN
1629	Pos=Req%Pos
1630	do i=1,Req%NbRequest
1631	PtrHallo=>Req%Hallo(i)
1632	offset=(PtrHallo%offset-1)*iip1+1
1633	Nb=iip1*PtrHallo%size-1
1634	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1635	do l=1,PtrHallo%NbLevel
1636	!cdir NODEP
1637	do ij=0,Nb
1638	PtrHallo%Field(offset+ij,l)=Buffer(Pos+ij)
1639	enddo
1640	Pos=Pos+Nb+1
1641	enddo
1642	!$OMP END DO NOWAIT
1643	enddo
1644	endif
1645	enddo
1646
1647
1648	do rank=0,MPI_SIZE-1
1649	Req=>a_request%RequestRecv(rank)
1650	IF (Req%NbRequest>0) THEN
1651	CALL deallocate_buffer(Req%Index)
1652	Req%NbRequest=0
1653	endif
1654	enddo
1655
1656	a_request%tag=1
1657	END SUBROUTINE WaitRecvRequest
1658
1659
1660
1661	SUBROUTINE CopyField(FieldS,FieldR,ij,ll,jj_Nb_New)
1662	USE dimensions_mod
1663
1664	IMPLICIT NONE
1665
1666	INTEGER :: ij,ll,l
1667	REAL, DIMENSION(ij,ll) :: FieldS
1668	REAL, DIMENSION(ij,ll) :: FieldR
1669	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
1670	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
1671
1672	INTEGER ::i,jje,jjb,ijb,ije
1673
1674	jj_begin_New(0)=1
1675	jj_End_New(0)=jj_Nb_New(0)
1676	do i=1,MPI_Size-1
1677	jj_begin_New(i)=jj_end_New(i-1)+1
1678	jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
1679	enddo
1680
1681	jjb=max(jj_begin,jj_begin_new(MPI_Rank))
1682	jje=min(jj_end,jj_end_new(MPI_Rank))
1683	IF (ij==ip1jm) jje=min(jje,jjm)
1684
1685	IF (jje >= jjb) THEN
1686	ijb=(jjb-1)*iip1+1
1687	ije=jje*iip1
1688
1689	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1690	do l=1,ll
1691	FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
1692	enddo
1693	!$OMP ENDDO NOWAIT
1694	endif
1695
1696
1697	END SUBROUTINE CopyField
1698
1699	SUBROUTINE CopyFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down)
1700	USE dimensions_mod
1701
1702	IMPLICIT NONE
1703
1704	INTEGER :: ij,ll,Up,Down
1705	REAL, DIMENSION(ij,ll) :: FieldS
1706	REAL, DIMENSION(ij,ll) :: FieldR
1707	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
1708	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
1709
1710	INTEGER ::i,jje,jjb,ijb,ije,l
1711
1712
1713	jj_begin_New(0)=1
1714	jj_End_New(0)=jj_Nb_New(0)
1715	do i=1,MPI_Size-1
1716	jj_begin_New(i)=jj_end_New(i-1)+1
1717	jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
1718	enddo
1719
1720
1721	jjb=max(jj_begin,jj_begin_new(MPI_Rank)-Up)
1722	jje=min(jj_end,jj_end_new(MPI_Rank)+Down)
1723	IF (ij==ip1jm) jje=min(jje,jjm)
1724
1725
1726	IF (jje >= jjb) THEN
1727	ijb=(jjb-1)*iip1+1
1728	ije=jje*iip1
1729
1730	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1731	do l=1,ll
1732	FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
1733	enddo
1734	!$OMP ENDDO NOWAIT
1735
1736	endif
1737	END SUBROUTINE CopyFieldHallo
1738
1739	SUBROUTINE Gather_field_u(field_loc,field_glo,ll)
1740	USE dimensions_mod
1741	IMPLICIT NONE
1742	INTEGER :: ll
1743	REAL :: field_loc(ijb_u:ije_u,ll)
1744	REAL :: field_glo(ip1jmp1,ll)
1745	type(request) :: request_gather
1746	INTEGER :: l
1747
1748
1749	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1750	DO l=1,ll
1751	field_glo(ij_begin:ij_end,l)=field_loc(ij_begin:ij_end,l)
1752	ENDDO
1753
1754	CALL register_SwapField(field_glo,field_glo,ip1jmp1,ll,distrib_gather%jj_nb_para,request_gather)
1755	CALL SendRequest(request_gather)
1756	!$OMP BARRIER
1757	CALL WaitRequest(request_gather)
1758	!$OMP BARRIER
1759
1760	END SUBROUTINE Gather_field_u
1761
1762	SUBROUTINE Gather_field_v(field_loc,field_glo,ll)
1763	USE dimensions_mod
1764	IMPLICIT NONE
1765	INTEGER :: ll
1766	REAL :: field_loc(ijb_v:ije_v,ll)
1767	REAL :: field_glo(ip1jm,ll)
1768	type(request) :: request_gather
1769	INTEGER :: ijb,ije
1770	INTEGER :: l
1771
1772
1773	ijb=ij_begin
1774	ije=ij_end
1775	IF (pole_sud) ije=ij_end-iip1
1776
1777	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1778	DO l=1,ll
1779	field_glo(ijb:ije,l)=field_loc(ijb:ije,l)
1780	ENDDO
1781
1782	CALL register_SwapField(field_glo,field_glo,ip1jm,ll,distrib_gather%jj_nb_para,request_gather)
1783	CALL SendRequest(request_gather)
1784	!$OMP BARRIER
1785	CALL WaitRequest(request_gather)
1786	!$OMP BARRIER
1787
1788	END SUBROUTINE Gather_field_v
1789
1790	SUBROUTINE Scatter_field_u(field_glo,field_loc,ll)
1791	USE dimensions_mod
1792	IMPLICIT NONE
1793	INTEGER :: ll
1794	REAL :: field_glo(ip1jmp1,ll)
1795	REAL :: field_loc(ijb_u:ije_u,ll)
1796	type(request) :: request_gather
1797	TYPE(distrib) :: distrib_swap
1798	INTEGER :: l
1799
1800	!$OMP BARRIER
1801	!$OMP MASTER
1802	CALL get_current_distrib(distrib_swap)
1803	CALL set_Distrib(distrib_gather)
1804	!$OMP END MASTER
1805	!$OMP BARRIER
1806
1807	CALL register_SwapField(field_glo,field_glo,ip1jmp1,ll,distrib_swap%jj_nb_para,request_gather)
1808	CALL SendRequest(request_gather)
1809	!$OMP BARRIER
1810	CALL WaitRequest(request_gather)
1811	!$OMP BARRIER
1812	!$OMP MASTER
1813	CALL set_Distrib(distrib_swap)
1814	!$OMP END MASTER
1815	!$OMP BARRIER
1816
1817	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1818	DO l=1,ll
1819	field_loc(ij_begin:ij_end,l)=field_glo(ij_begin:ij_end,l)
1820	ENDDO
1821
1822	END SUBROUTINE Scatter_field_u
1823
1824	SUBROUTINE Scatter_field_v(field_glo,field_loc,ll)
1825	USE dimensions_mod
1826	IMPLICIT NONE
1827	INTEGER :: ll
1828	REAL :: field_glo(ip1jmp1,ll)
1829	REAL :: field_loc(ijb_v:ije_v,ll)
1830	type(request) :: request_gather
1831	TYPE(distrib) :: distrib_swap
1832	INTEGER :: ijb,ije,l
1833
1834
1835	!$OMP BARRIER
1836	!$OMP MASTER
1837	CALL get_current_distrib(distrib_swap)
1838	CALL set_Distrib(distrib_gather)
1839	!$OMP END MASTER
1840	!$OMP BARRIER
1841	CALL register_SwapField(field_glo,field_glo,ip1jm,ll,distrib_swap%jj_nb_para,request_gather)
1842	CALL SendRequest(request_gather)
1843	!$OMP BARRIER
1844	CALL WaitRequest(request_gather)
1845	!$OMP BARRIER
1846	!$OMP MASTER
1847	CALL set_Distrib(distrib_swap)
1848	!$OMP END MASTER
1849	!$OMP BARRIER
1850	ijb=ij_begin
1851	ije=ij_end
1852	IF (pole_sud) ije=ij_end-iip1
1853
1854	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1855	DO l=1,ll
1856	field_loc(ijb:ije,l)=field_glo(ijb:ije,l)
1857	ENDDO
1858
1859	END SUBROUTINE Scatter_field_v
1860
1861	END MODULE mod_Hallo
1862

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

Download in other formats:

Original Format