source: LMDZ6/trunk/libf/dyn3dmem/mod_hallo.F90 @ 4660

Last change on this file since 4660 was 4600, checked in by yann meurdesoif, 18 months ago

Suppress CPP_MPI key usage in source code. MPI wrappers is used to supress missing symbol if the mpi library is not linked

YM

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