Context Navigation

mod_hallo.f90 @ 5362

Last change on this file since 5362 was 5362, checked in by abarral, 41 hours ago
(fix previous) remove nonexisting imported vars
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: 55.3 KB

Rev	Line
[1632]	1	module mod_Hallo
[1823]	2	USE parallel_lmdz
[1632]	3	implicit none
	4	logical,save :: use_mpi_alloc
	5	integer, parameter :: MaxProc=512
[1847]	6	integer, parameter :: DefaultMaxBufferSize=10241024100
	7	integer, SAVE :: MaxBufferSize=0
[1632]	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
[1847]	30	integer :: NbRequestMax=0
[1632]	31	integer :: BufferSize
	32	integer :: Pos
	33	integer :: Index
[1847]	34	type(Hallo), POINTER :: Hallo(:)
[1632]	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
[2436]	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
[1632]	50	END INTERFACE Register_SwapField_u
	51
	52	INTERFACE Register_SwapField_v
[2436]	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
[1632]	55	END INTERFACE Register_SwapField_v
	56
	57	INTERFACE Register_SwapField2d_u
[2436]	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
[1632]	60	END INTERFACE Register_SwapField2d_u
	61
	62	INTERFACE Register_SwapField2d_v
[2436]	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
[1632]	65	END INTERFACE Register_SwapField2d_v
	66
	67	contains
	68
	69	subroutine Init_mod_hallo
[5272]	70	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	71	USE paramet_mod_h
[5272]	72	USE IOIPSL
[1632]	73	implicit none
	74	integer :: jj_nb_gather(0:mpi_size-1)
	75
	76	Index_Pos=1
	77	Buffer_Pos(Index_Pos)=1
	78	MaxBufferSize_Used=0
[1847]	79	!$OMP MASTER
	80	MaxBufferSize=DefaultMaxBufferSize
	81	CALL getin("mpi_buffer_size",MaxBufferSize)
	82	!$OMP END MASTER
	83	!$OMP BARRIER
	84
[1632]	85	IF (use_mpi_alloc .AND. using_mpi) THEN
	86	CALL create_global_mpi_buffer
	87	ELSE
	88	CALL create_standard_mpi_buffer
	89	ENDIF
	90
[1803]	91	!$OMP MASTER
[1632]	92	jj_nb_gather(:)=0
	93	jj_nb_gather(0)=jjp1
	94
	95	CALL create_distrib(jj_nb_gather,distrib_gather)
[1803]	96	!$OMP END MASTER
	97	!$OMP BARRIER
[1847]	98
[1632]	99	end subroutine init_mod_hallo
	100
	101	SUBROUTINE create_standard_mpi_buffer
	102	IMPLICIT NONE
	103
	104	ALLOCATE(Buffer(MaxBufferSize))
	105
	106	END SUBROUTINE create_standard_mpi_buffer
	107
	108	SUBROUTINE create_global_mpi_buffer
[4600]	109	USE lmdz_mpi
[1632]	110	IMPLICIT NONE
	111	POINTER (Pbuffer,MPI_Buffer(MaxBufferSize))
	112	REAL :: MPI_Buffer
	113	INTEGER(KIND=MPI_ADDRESS_KIND) :: BS
	114	INTEGER :: i,ierr
	115
	116	! Allocation du buffer MPI
	117	Bs=8*MaxBufferSize
	118	!$OMP CRITICAL (MPI)
	119	CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
	120	!$OMP END CRITICAL (MPI)
	121	DO i=1,MaxBufferSize
	122	MPI_Buffer(i)=i
	123	ENDDO
	124
	125	CALL Associate_buffer(MPI_Buffer)
	126
	127	CONTAINS
	128
	129	SUBROUTINE Associate_buffer(MPI_Buffer)
	130	IMPLICIT NONE
	131	REAL,DIMENSION(:),target :: MPI_Buffer
	132
	133	Buffer=>MPI_Buffer
	134
	135	END SUBROUTINE Associate_buffer
	136
	137	END SUBROUTINE create_global_mpi_buffer
	138
	139
	140	subroutine allocate_buffer(Size,Index,Pos)
	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 !!!!'
[4469]	149	CALL abort_gcm("mod_hallo","stopped",1)
[1632]	150	endif
	151
	152	if (Index_pos>=ListSize) then
	153	print *,'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
[4469]	154	CALL abort_gcm("mod_hallo","stopped",1)
[1632]	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
[1847]	185	subroutine New_Hallo(Field,Stride,NbLevel,offset,size,Ptr_request)
[1632]	186	integer :: Stride
	187	integer :: NbLevel
	188	integer :: size
	189	integer :: offset
	190	real, dimension(Stride,NbLevel),target :: Field
[1847]	191	type(request_SR),pointer :: Ptr_request
	192	type(Hallo),POINTER :: NewHallos(:),HalloSwitch(:), NewHallo
[1632]	193
[1847]	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
[1632]	209	NewHallo%Field=>Field
	210	NewHallo%Stride=Stride
	211	NewHallo%NbLevel=NbLevel
	212	NewHallo%size=size
	213	NewHallo%offset=offset
	214
[1847]	215	end subroutine New_Hallo
[1632]	216
	217	subroutine Register_SendField(Field,ij,ll,offset,size,target,a_request)
[5272]	218	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	219	implicit none
[1632]	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)
[1847]	228
	229	call New_Hallo(Field,ij,ll,offset,size,Ptr_request)
[1632]	230
	231	end subroutine Register_SendField
	232
	233	subroutine Register_RecvField(Field,ij,ll,offset,size,target,a_request)
[5272]	234	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	235	implicit none
[1632]	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
[1847]	245	call New_Hallo(Field,ij,ll,offset,size,Ptr_request)
[1632]	246
	247
	248	end subroutine Register_RecvField
	249
	250	subroutine Register_SwapField(FieldS,FieldR,ij,ll,jj_Nb_New,a_request)
[5272]	251	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5362]	252	USE paramet_mod_h
[5272]	253	implicit none
[1632]	254
	255
	256	INTEGER :: ij,ll
	257	REAL, dimension(ij,ll) :: FieldS
	258	REAL, dimension(ij,ll) :: FieldR
	259	type(request) :: a_request
	260	integer,dimension(0:MPI_Size-1) :: jj_Nb_New
	261	integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
	262
	263	integer ::i,jje,jjb
	264
	265	jj_begin_New(0)=1
	266	jj_End_New(0)=jj_Nb_New(0)
	267	do i=1,MPI_Size-1
	268	jj_begin_New(i)=jj_end_New(i-1)+1
	269	jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
	270	enddo
	271
	272	do i=0,MPI_Size-1
	273	if (i /= MPI_Rank) then
	274	jjb=max(jj_begin_new(i),jj_begin)
	275	jje=min(jj_end_new(i),jj_end)
	276
	277	if (ij==ip1jm .and. jje==jjp1) jje=jjm
	278
	279	if (jje >= jjb) then
	280	call Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
	281	endif
	282
	283	jjb=max(jj_begin_new(MPI_Rank),jj_begin_Para(i))
	284	jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
	285
	286	if (ij==ip1jm .and. jje==jjp1) jje=jjm
	287
	288	if (jje >= jjb) then
	289	call Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
	290	endif
	291
	292	endif
	293	enddo
	294
	295	end subroutine Register_SwapField
	296
	297
	298
	299	subroutine Register_SwapFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down,a_request)
[5272]	300	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5362]	301	USE paramet_mod_h
[1632]	302	implicit none
	303
	304	INTEGER :: ij,ll,Up,Down
	305	REAL, dimension(ij,ll) :: FieldS
	306	REAL, dimension(ij,ll) :: FieldR
	307	type(request) :: a_request
	308	integer,dimension(0:MPI_Size-1) :: jj_Nb_New
	309	integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
	310
	311	integer ::i,jje,jjb
	312
	313	jj_begin_New(0)=1
	314	jj_End_New(0)=jj_Nb_New(0)
	315	do i=1,MPI_Size-1
	316	jj_begin_New(i)=jj_end_New(i-1)+1
	317	jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
	318	enddo
	319
	320	do i=0,MPI_Size-1
	321	jj_begin_New(i)=max(1,jj_begin_New(i)-Up)
	322	jj_end_New(i)=min(jjp1,jj_end_new(i)+Down)
	323	enddo
	324
	325	do i=0,MPI_Size-1
	326	if (i /= MPI_Rank) then
	327	jjb=max(jj_begin_new(i),jj_begin)
	328	jje=min(jj_end_new(i),jj_end)
	329
	330	if (ij==ip1jm .and. jje==jjp1) jje=jjm
	331
	332	if (jje >= jjb) then
	333	call Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
	334	endif
	335
	336	jjb=max(jj_begin_new(MPI_Rank),jj_begin_Para(i))
	337	jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
	338
	339	if (ij==ip1jm .and. jje==jjp1) jje=jjm
	340
	341	if (jje >= jjb) then
	342	call Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
	343	endif
	344
	345	endif
	346	enddo
	347
	348	end subroutine Register_SwapFieldHallo
	349
	350
	351
[2436]	352	SUBROUTINE Register_SwapField1d_u(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	353	USE parallel_lmdz
[5272]	354	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	355	IMPLICIT NONE
[1632]	356
	357	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	358	REAL, DIMENSION(current_dist%ijb_u:),INTENT(IN) :: FieldS
	359	REAL, DIMENSION(new_dist%ijb_u:),INTENT(OUT) :: FieldR
[1632]	360	INTEGER,OPTIONAL,INTENT(IN) :: up
	361	INTEGER,OPTIONAL,INTENT(IN) :: down
	362	TYPE(request),INTENT(INOUT) :: a_request
	363
	364	INTEGER :: halo_up
	365	INTEGER :: halo_down
	366
	367
	368	halo_up=0
	369	halo_down=0
	370	IF (PRESENT(up)) halo_up=up
	371	IF (PRESENT(down)) halo_down=down
	372
[2436]	373	CALL Register_SwapField_gen_u(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	374
	375	END SUBROUTINE Register_SwapField1d_u
	376
[2436]	377	SUBROUTINE Register_SwapField1d_u_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	378	USE parallel_lmdz
[5272]	379	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	380	IMPLICIT NONE
[2436]	381
	382	TYPE(distrib),INTENT(IN) :: new_dist
	383	TYPE(distrib),INTENT(IN) :: old_dist
	384	REAL, DIMENSION(old_dist%ijb_u:),INTENT(IN) :: FieldS
	385	REAL, DIMENSION(new_dist%ijb_u:),INTENT(OUT) :: FieldR
	386	INTEGER,OPTIONAL,INTENT(IN) :: up
	387	INTEGER,OPTIONAL,INTENT(IN) :: down
	388	TYPE(request),INTENT(INOUT) :: a_request
[1632]	389
[2436]	390	INTEGER :: halo_up
	391	INTEGER :: halo_down
	392
	393
	394	halo_up=0
	395	halo_down=0
	396	IF (PRESENT(up)) halo_up=up
	397	IF (PRESENT(down)) halo_down=down
	398
	399	CALL Register_SwapField_gen_u(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
	400
	401	END SUBROUTINE Register_SwapField1d_u_bis
	402
	403
	404	SUBROUTINE Register_SwapField2d_u1d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	405	USE parallel_lmdz
[5272]	406	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	407	IMPLICIT NONE
[1632]	408
	409	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	410	REAL, DIMENSION(current_dist%ijb_u:,:),INTENT(IN) :: FieldS
	411	REAL, DIMENSION(new_dist%ijb_u:,:),INTENT(OUT) :: FieldR
[1632]	412	INTEGER,OPTIONAL,INTENT(IN) :: up
	413	INTEGER,OPTIONAL,INTENT(IN) :: down
	414	TYPE(request),INTENT(INOUT) :: a_request
	415
	416	INTEGER :: halo_up
	417	INTEGER :: halo_down
	418	INTEGER :: ll
	419
	420
	421	halo_up=0
	422	halo_down=0
	423	IF (PRESENT(up)) halo_up=up
	424	IF (PRESENT(down)) halo_down=down
	425
	426	ll=size(FieldS,2)
	427
[2436]	428	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	429
	430	END SUBROUTINE Register_SwapField2d_u1d
[2436]	431
	432	SUBROUTINE Register_SwapField2d_u1d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	433	USE parallel_lmdz
[5272]	434	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	435	IMPLICIT NONE
[2436]	436
	437	TYPE(distrib),INTENT(IN) :: new_dist
	438	TYPE(distrib),INTENT(IN) :: old_dist
	439	REAL, DIMENSION(old_dist%ijb_u:,:),INTENT(IN) :: FieldS
	440	REAL, DIMENSION(new_dist%ijb_u:,:),INTENT(OUT) :: FieldR
	441	INTEGER,OPTIONAL,INTENT(IN) :: up
	442	INTEGER,OPTIONAL,INTENT(IN) :: down
	443	TYPE(request),INTENT(INOUT) :: a_request
	444
	445	INTEGER :: halo_up
	446	INTEGER :: halo_down
	447	INTEGER :: ll
	448
	449
	450	halo_up=0
	451	halo_down=0
	452	IF (PRESENT(up)) halo_up=up
	453	IF (PRESENT(down)) halo_down=down
	454
	455	ll=size(FieldS,2)
	456
	457	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
	458
	459	END SUBROUTINE Register_SwapField2d_u1d_bis
[1632]	460
	461
[2436]	462	SUBROUTINE Register_SwapField3d_u(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	463	USE parallel_lmdz
[5272]	464	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	465	IMPLICIT NONE
[1632]	466
	467	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	468	REAL, DIMENSION(current_dist%ijb_u:,:,:),INTENT(IN) :: FieldS
	469	REAL, DIMENSION(new_dist%ijb_u:,:,:),INTENT(OUT) :: FieldR
[1632]	470	INTEGER,OPTIONAL,INTENT(IN) :: up
	471	INTEGER,OPTIONAL,INTENT(IN) :: down
	472	TYPE(request),INTENT(INOUT) :: a_request
	473
	474	INTEGER :: halo_up
	475	INTEGER :: halo_down
	476	INTEGER :: ll
	477
	478
	479	halo_up=0
	480	halo_down=0
	481	IF (PRESENT(up)) halo_up=up
	482	IF (PRESENT(down)) halo_down=down
	483
	484	ll=size(FieldS,2)*size(FieldS,3)
	485
[2436]	486	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	487
	488	END SUBROUTINE Register_SwapField3d_u
[2436]	489
	490	SUBROUTINE Register_SwapField3d_u_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	491	USE parallel_lmdz
[5272]	492	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	493	IMPLICIT NONE
[2436]	494
	495	TYPE(distrib),INTENT(IN) :: new_dist
	496	TYPE(distrib),INTENT(IN) :: old_dist
	497	REAL, DIMENSION(old_dist%ijb_u:,:,:),INTENT(IN) :: FieldS
	498	REAL, DIMENSION(new_dist%ijb_u:,:,:),INTENT(OUT) :: FieldR
	499	INTEGER,OPTIONAL,INTENT(IN) :: up
	500	INTEGER,OPTIONAL,INTENT(IN) :: down
	501	TYPE(request),INTENT(INOUT) :: a_request
	502
	503	INTEGER :: halo_up
	504	INTEGER :: halo_down
	505	INTEGER :: ll
	506
	507
	508	halo_up=0
	509	halo_down=0
	510	IF (PRESENT(up)) halo_up=up
	511	IF (PRESENT(down)) halo_down=down
	512
	513	ll=size(FieldS,2)*size(FieldS,3)
	514
	515	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
	516
	517	END SUBROUTINE Register_SwapField3d_u_bis
[1632]	518
	519
	520
[2436]	521	SUBROUTINE Register_SwapField1d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	522	USE parallel_lmdz
[5271]	523	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[1632]	524	IMPLICIT NONE
[2436]	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
[1632]	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
[2436]	542	CALL Register_SwapField_gen_u(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	543
	544	END SUBROUTINE Register_SwapField1d_u2d
	545
[2436]	546	SUBROUTINE Register_SwapField1d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	547	USE parallel_lmdz
[5271]	548	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[2436]	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)
[1823]	574	USE parallel_lmdz
[5271]	575	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[1632]	576	IMPLICIT NONE
	577
	578	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	579	REAL, DIMENSION(current_dist%jjb_u:,:,:),INTENT(IN) :: FieldS
	580	REAL, DIMENSION(new_dist%jjb_u:,:,:),INTENT(OUT) :: FieldR
[1632]	581	INTEGER,OPTIONAL,INTENT(IN) :: up
	582	INTEGER,OPTIONAL,INTENT(IN) :: down
	583	TYPE(request),INTENT(INOUT) :: a_request
	584
	585	INTEGER :: halo_up
	586	INTEGER :: halo_down
	587	INTEGER :: ll
	588
	589
	590	halo_up=0
	591	halo_down=0
	592	IF (PRESENT(up)) halo_up=up
	593	IF (PRESENT(down)) halo_down=down
	594
	595	ll=size(FieldS,3)
	596
[2436]	597	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	598
	599	END SUBROUTINE Register_SwapField2d_u2d
[2436]	600
	601	SUBROUTINE Register_SwapField2d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	602	USE parallel_lmdz
[5271]	603	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[2436]	604	IMPLICIT NONE
	605
	606	TYPE(distrib),INTENT(IN) :: new_dist
	607	TYPE(distrib),INTENT(IN) :: old_dist
	608	REAL, DIMENSION(old_dist%jjb_u:,:,:),INTENT(IN) :: FieldS
	609	REAL, DIMENSION(new_dist%jjb_u:,:,:),INTENT(OUT) :: FieldR
	610	INTEGER,OPTIONAL,INTENT(IN) :: up
	611	INTEGER,OPTIONAL,INTENT(IN) :: down
	612	TYPE(request),INTENT(INOUT) :: a_request
	613
	614	INTEGER :: halo_up
	615	INTEGER :: halo_down
	616	INTEGER :: ll
	617
	618
	619	halo_up=0
	620	halo_down=0
	621	IF (PRESENT(up)) halo_up=up
	622	IF (PRESENT(down)) halo_down=down
	623
	624	ll=size(FieldS,3)
	625
	626	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
	627
	628	END SUBROUTINE Register_SwapField2d_u2d_bis
[1632]	629
	630
[2436]	631	SUBROUTINE Register_SwapField3d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	632	USE parallel_lmdz
[5272]	633	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	634	IMPLICIT NONE
[1632]	635
	636	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	637	REAL, DIMENSION(current_dist%jjb_u:,:,:,:),INTENT(IN) :: FieldS
	638	REAL, DIMENSION(new_dist%jjb_u:,:,:,:),INTENT(OUT) :: FieldR
[1632]	639	INTEGER,OPTIONAL,INTENT(IN) :: up
	640	INTEGER,OPTIONAL,INTENT(IN) :: down
	641	TYPE(request),INTENT(INOUT) :: a_request
	642
	643	INTEGER :: halo_up
	644	INTEGER :: halo_down
	645	INTEGER :: ll
	646
	647
	648	halo_up=0
	649	halo_down=0
	650	IF (PRESENT(up)) halo_up=up
	651	IF (PRESENT(down)) halo_down=down
	652
	653	ll=size(FieldS,3)*size(FieldS,4)
	654
[2436]	655	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	656
	657	END SUBROUTINE Register_SwapField3d_u2d
	658
[2436]	659	SUBROUTINE Register_SwapField3d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	660	USE parallel_lmdz
[5272]	661	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	662	IMPLICIT NONE
[2436]	663
	664	TYPE(distrib),INTENT(IN) :: new_dist
	665	TYPE(distrib),INTENT(IN) :: old_dist
	666	REAL, DIMENSION(old_dist%jjb_u:,:,:,:),INTENT(IN) :: FieldS
	667	REAL, DIMENSION(new_dist%jjb_u:,:,:,:),INTENT(OUT) :: FieldR
	668	INTEGER,OPTIONAL,INTENT(IN) :: up
	669	INTEGER,OPTIONAL,INTENT(IN) :: down
	670	TYPE(request),INTENT(INOUT) :: a_request
[1632]	671
[2436]	672	INTEGER :: halo_up
	673	INTEGER :: halo_down
	674	INTEGER :: ll
	675
	676
	677	halo_up=0
	678	halo_down=0
	679	IF (PRESENT(up)) halo_up=up
	680	IF (PRESENT(down)) halo_down=down
	681
	682	ll=size(FieldS,3)*size(FieldS,4)
	683
	684	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
	685
	686	END SUBROUTINE Register_SwapField3d_u2d_bis
[1632]	687
	688
	689
	690
	691
[2436]	692
	693
	694	SUBROUTINE Register_SwapField1d_v(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	695	USE parallel_lmdz
[5272]	696	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	697	IMPLICIT NONE
[1632]	698
	699	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	700	REAL, DIMENSION(current_dist%ijb_v:),INTENT(IN) :: FieldS
	701	REAL, DIMENSION(new_dist%ijb_v:),INTENT(OUT) :: FieldR
[1632]	702	INTEGER,OPTIONAL,INTENT(IN) :: up
	703	INTEGER,OPTIONAL,INTENT(IN) :: down
	704	TYPE(request),INTENT(INOUT) :: a_request
	705
	706	INTEGER :: halo_up
	707	INTEGER :: halo_down
	708
	709
	710	halo_up=0
	711	halo_down=0
	712	IF (PRESENT(up)) halo_up=up
	713	IF (PRESENT(down)) halo_down=down
	714
[2436]	715	CALL Register_SwapField_gen_v(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	716
	717	END SUBROUTINE Register_SwapField1d_v
	718
[2436]	719	SUBROUTINE Register_SwapField1d_v_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	720	USE parallel_lmdz
[5272]	721	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	722	IMPLICIT NONE
[2436]	723
	724	TYPE(distrib),INTENT(IN) :: new_dist
	725	TYPE(distrib),INTENT(IN) :: old_dist
	726	REAL, DIMENSION(old_dist%ijb_v:),INTENT(IN) :: FieldS
	727	REAL, DIMENSION(new_dist%ijb_v:),INTENT(OUT) :: FieldR
	728	INTEGER,OPTIONAL,INTENT(IN) :: up
	729	INTEGER,OPTIONAL,INTENT(IN) :: down
	730	TYPE(request),INTENT(INOUT) :: a_request
[1632]	731
[2436]	732	INTEGER :: halo_up
	733	INTEGER :: halo_down
	734
	735
	736	halo_up=0
	737	halo_down=0
	738	IF (PRESENT(up)) halo_up=up
	739	IF (PRESENT(down)) halo_down=down
	740
	741	CALL Register_SwapField_gen_v(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
	742
	743	END SUBROUTINE Register_SwapField1d_v_bis
	744
	745
	746	SUBROUTINE Register_SwapField2d_v1d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	747	USE parallel_lmdz
[5272]	748	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	749	IMPLICIT NONE
[1632]	750
	751	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	752	REAL, DIMENSION(current_dist%ijb_v:,:),INTENT(IN) :: FieldS
	753	REAL, DIMENSION(new_dist%ijb_v:,:),INTENT(OUT) :: FieldR
[1632]	754	INTEGER,OPTIONAL,INTENT(IN) :: up
	755	INTEGER,OPTIONAL,INTENT(IN) :: down
	756	TYPE(request),INTENT(INOUT) :: a_request
	757
	758	INTEGER :: halo_up
	759	INTEGER :: halo_down
	760	INTEGER :: ll
	761
	762
	763	halo_up=0
	764	halo_down=0
	765	IF (PRESENT(up)) halo_up=up
	766	IF (PRESENT(down)) halo_down=down
	767
	768	ll=size(FieldS,2)
	769
[2436]	770	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	771
	772	END SUBROUTINE Register_SwapField2d_v1d
[2436]	773
	774	SUBROUTINE Register_SwapField2d_v1d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	775	USE parallel_lmdz
[5272]	776	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	777	IMPLICIT NONE
[1632]	778
[2436]	779	TYPE(distrib),INTENT(IN) :: new_dist
	780	TYPE(distrib),INTENT(IN) :: old_dist
	781	REAL, DIMENSION(old_dist%ijb_v:,:),INTENT(IN) :: FieldS
	782	REAL, DIMENSION(new_dist%ijb_v:,:),INTENT(OUT) :: FieldR
	783	INTEGER,OPTIONAL,INTENT(IN) :: up
	784	INTEGER,OPTIONAL,INTENT(IN) :: down
	785	TYPE(request),INTENT(INOUT) :: a_request
[1632]	786
[2436]	787	INTEGER :: halo_up
	788	INTEGER :: halo_down
	789	INTEGER :: ll
	790
	791
	792	halo_up=0
	793	halo_down=0
	794	IF (PRESENT(up)) halo_up=up
	795	IF (PRESENT(down)) halo_down=down
	796
	797	ll=size(FieldS,2)
	798
	799	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
	800
	801	END SUBROUTINE Register_SwapField2d_v1d_bis
	802
	803
	804
	805	SUBROUTINE Register_SwapField3d_v(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	806	USE parallel_lmdz
[5272]	807	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	808	IMPLICIT NONE
[1632]	809
	810	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	811	REAL, DIMENSION(current_dist%ijb_v:,:,:),INTENT(IN) :: FieldS
	812	REAL, DIMENSION(new_dist%ijb_v:,:,:),INTENT(OUT) :: FieldR
[1632]	813	INTEGER,OPTIONAL,INTENT(IN) :: up
	814	INTEGER,OPTIONAL,INTENT(IN) :: down
	815	TYPE(request),INTENT(INOUT) :: a_request
	816
	817	INTEGER :: halo_up
	818	INTEGER :: halo_down
	819	INTEGER :: ll
	820
	821
	822	halo_up=0
	823	halo_down=0
	824	IF (PRESENT(up)) halo_up=up
	825	IF (PRESENT(down)) halo_down=down
	826
	827	ll=size(FieldS,2)*size(FieldS,3)
	828
[2436]	829	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	830
	831	END SUBROUTINE Register_SwapField3d_v
	832
[2436]	833	SUBROUTINE Register_SwapField3d_v_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	834	USE parallel_lmdz
[5272]	835	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	836	IMPLICIT NONE
[2436]	837
	838	TYPE(distrib),INTENT(IN) :: new_dist
	839	TYPE(distrib),INTENT(IN) :: old_dist
	840	REAL, DIMENSION(old_dist%ijb_v:,:,:),INTENT(IN) :: FieldS
	841	REAL, DIMENSION(new_dist%ijb_v:,:,:),INTENT(OUT) :: FieldR
	842	INTEGER,OPTIONAL,INTENT(IN) :: up
	843	INTEGER,OPTIONAL,INTENT(IN) :: down
	844	TYPE(request),INTENT(INOUT) :: a_request
[1632]	845
[2436]	846	INTEGER :: halo_up
	847	INTEGER :: halo_down
	848	INTEGER :: ll
	849
	850
	851	halo_up=0
	852	halo_down=0
	853	IF (PRESENT(up)) halo_up=up
	854	IF (PRESENT(down)) halo_down=down
	855
	856	ll=size(FieldS,2)*size(FieldS,3)
	857
	858	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
	859
	860	END SUBROUTINE Register_SwapField3d_v_bis
[1632]	861
	862
[2436]	863
	864
	865	SUBROUTINE Register_SwapField1d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	866	USE parallel_lmdz
[5272]	867	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	868	IMPLICIT NONE
[1632]	869
[2436]	870	TYPE(distrib),INTENT(IN) :: new_dist !LF
	871	REAL, DIMENSION(current_dist%jjb_v:,:),INTENT(IN) :: FieldS
	872	REAL, DIMENSION(new_dist%jjb_v:,:),INTENT(OUT) :: FieldR
[1632]	873	INTEGER,OPTIONAL,INTENT(IN) :: up
	874	INTEGER,OPTIONAL,INTENT(IN) :: down
	875	TYPE(request),INTENT(INOUT) :: a_request
	876
	877	INTEGER :: halo_up
	878	INTEGER :: halo_down
	879
	880
	881	halo_up=0
	882	halo_down=0
	883	IF (PRESENT(up)) halo_up=up
	884	IF (PRESENT(down)) halo_down=down
	885
[2436]	886	CALL Register_SwapField_gen_v(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	887
	888	END SUBROUTINE Register_SwapField1d_v2d
	889
[2436]	890	SUBROUTINE Register_SwapField1d_v2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	891	USE parallel_lmdz
[5272]	892	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	893	IMPLICIT NONE
[2436]	894
	895	TYPE(distrib),INTENT(IN) :: new_dist !LF
	896	TYPE(distrib),INTENT(IN) :: old_dist
	897	REAL, DIMENSION(old_dist%jjb_v:,:),INTENT(IN) :: FieldS
	898	REAL, DIMENSION(new_dist%jjb_v:,:),INTENT(OUT) :: FieldR
	899	INTEGER,OPTIONAL,INTENT(IN) :: up
	900	INTEGER,OPTIONAL,INTENT(IN) :: down
	901	TYPE(request),INTENT(INOUT) :: a_request
[1632]	902
[2436]	903	INTEGER :: halo_up
	904	INTEGER :: halo_down
	905
	906
	907	halo_up=0
	908	halo_down=0
	909	IF (PRESENT(up)) halo_up=up
	910	IF (PRESENT(down)) halo_down=down
	911
	912	CALL Register_SwapField_gen_v(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
	913
	914	END SUBROUTINE Register_SwapField1d_v2d_bis
	915
	916
	917	SUBROUTINE Register_SwapField2d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	918	USE parallel_lmdz
[5272]	919	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	920	IMPLICIT NONE
[1632]	921
	922	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	923	REAL, DIMENSION(current_dist%jjb_v:,:,:),INTENT(IN) :: FieldS
	924	REAL, DIMENSION(new_dist%jjb_v:,:,:),INTENT(OUT) :: FieldR
[1632]	925	INTEGER,OPTIONAL,INTENT(IN) :: up
	926	INTEGER,OPTIONAL,INTENT(IN) :: down
	927	TYPE(request),INTENT(INOUT) :: a_request
	928
	929	INTEGER :: halo_up
	930	INTEGER :: halo_down
	931	INTEGER :: ll
	932
	933
	934	halo_up=0
	935	halo_down=0
	936	IF (PRESENT(up)) halo_up=up
	937	IF (PRESENT(down)) halo_down=down
	938
	939	ll=size(FieldS,3)
	940
[2436]	941	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	942
	943	END SUBROUTINE Register_SwapField2d_v2d
	944
[2436]	945	SUBROUTINE Register_SwapField2d_v2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	946	USE parallel_lmdz
[5272]	947	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	948	IMPLICIT NONE
[2436]	949
	950	TYPE(distrib),INTENT(IN) :: new_dist
	951	TYPE(distrib),INTENT(IN) :: old_dist
	952	REAL, DIMENSION(old_dist%jjb_v:,:,:),INTENT(IN) :: FieldS
	953	REAL, DIMENSION(new_dist%jjb_v:,:,:),INTENT(OUT) :: FieldR
	954	INTEGER,OPTIONAL,INTENT(IN) :: up
	955	INTEGER,OPTIONAL,INTENT(IN) :: down
	956	TYPE(request),INTENT(INOUT) :: a_request
[1632]	957
[2436]	958	INTEGER :: halo_up
	959	INTEGER :: halo_down
	960	INTEGER :: ll
	961
	962
	963	halo_up=0
	964	halo_down=0
	965	IF (PRESENT(up)) halo_up=up
	966	IF (PRESENT(down)) halo_down=down
	967
	968	ll=size(FieldS,3)
	969
	970	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
	971
	972	END SUBROUTINE Register_SwapField2d_v2d_bis
	973
	974
	975	SUBROUTINE Register_SwapField3d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	976	USE parallel_lmdz
[5272]	977	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	978	IMPLICIT NONE
[1632]	979
	980	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	981	REAL, DIMENSION(current_dist%jjb_v:,:,:,:),INTENT(IN) :: FieldS
	982	REAL, DIMENSION(new_dist%jjb_v:,:,:,:),INTENT(OUT) :: FieldR
[1632]	983	INTEGER,OPTIONAL,INTENT(IN) :: up
	984	INTEGER,OPTIONAL,INTENT(IN) :: down
	985	TYPE(request),INTENT(INOUT) :: a_request
	986
	987	INTEGER :: halo_up
	988	INTEGER :: halo_down
	989	INTEGER :: ll
	990
	991
	992	halo_up=0
	993	halo_down=0
	994	IF (PRESENT(up)) halo_up=up
	995	IF (PRESENT(down)) halo_down=down
	996
	997	ll=size(FieldS,3)*size(FieldS,4)
	998
[2436]	999	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	1000
	1001	END SUBROUTINE Register_SwapField3d_v2d
	1002
[2436]	1003	SUBROUTINE Register_SwapField3d_v2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	1004	USE parallel_lmdz
[5272]	1005	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	1006	IMPLICIT NONE
[2436]	1007
	1008	TYPE(distrib),INTENT(IN) :: new_dist
	1009	TYPE(distrib),INTENT(IN) :: old_dist
	1010	REAL, DIMENSION(old_dist%jjb_v:,:,:,:),INTENT(IN) :: FieldS
	1011	REAL, DIMENSION(new_dist%jjb_v:,:,:,:),INTENT(OUT) :: FieldR
	1012	INTEGER,OPTIONAL,INTENT(IN) :: up
	1013	INTEGER,OPTIONAL,INTENT(IN) :: down
	1014	TYPE(request),INTENT(INOUT) :: a_request
	1015
	1016	INTEGER :: halo_up
	1017	INTEGER :: halo_down
	1018	INTEGER :: ll
	1019
	1020
	1021	halo_up=0
	1022	halo_down=0
	1023	IF (PRESENT(up)) halo_up=up
	1024	IF (PRESENT(down)) halo_down=down
	1025
	1026	ll=size(FieldS,3)*size(FieldS,4)
	1027
	1028	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
	1029
	1030	END SUBROUTINE Register_SwapField3d_v2d_bis
[1632]	1031
[2436]	1032
[1632]	1033
	1034	SUBROUTINE Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,Up,Down,a_request)
[5272]	1035	USE parallel_lmdz
	1036	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5362]	1037	USE paramet_mod_h
[5272]	1038	IMPLICIT NONE
[1632]	1039
	1040	INTEGER :: ll,Up,Down
	1041	TYPE(distrib) :: old_dist
	1042	TYPE(distrib) :: new_dist
	1043	REAL, DIMENSION(old_dist%ijb_u:old_dist%ije_u,ll) :: FieldS
	1044	REAL, DIMENSION(new_dist%ijb_u:new_dist%ije_u,ll) :: FieldR
	1045	TYPE(request) :: a_request
	1046	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
	1047	INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
	1048
	1049	INTEGER ::i,l,jje,jjb,ijb,ije
	1050
	1051	DO i=0,MPI_Size-1
	1052	jj_begin_New(i)=max(1,new_dist%jj_begin_para(i)-Up)
	1053	jj_end_New(i)=min(jjp1,new_dist%jj_end_para(i)+Down)
	1054	ENDDO
	1055
	1056	DO i=0,MPI_Size-1
	1057	IF (i /= MPI_Rank) THEN
	1058	jjb=max(jj_begin_new(i),old_dist%jj_begin)
	1059	jje=min(jj_end_new(i),old_dist%jj_end)
	1060
	1061	IF (jje >= jjb) THEN
	1062	CALL Register_SendField(FieldS,old_dist%ijnb_u,ll,jjb-old_dist%jjb_u+1,jje-jjb+1,i,a_request)
	1063	ENDIF
	1064
	1065	jjb=max(jj_begin_new(MPI_Rank),old_dist%jj_begin_Para(i))
	1066	jje=min(jj_end_new(MPI_Rank),old_dist%jj_end_Para(i))
	1067
	1068	IF (jje >= jjb) THEN
	1069	CALL Register_RecvField(FieldR,new_dist%ijnb_u,ll,jjb-new_dist%jjb_u+1,jje-jjb+1,i,a_request)
	1070	ENDIF
	1071	ELSE
	1072	jjb=max(jj_begin_new(i),old_dist%jj_begin)
	1073	jje=min(jj_end_new(i),old_dist%jj_end)
	1074	ijb=(jjb-1)*iip1+1
	1075	ije=jje*iip1
	1076	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1077	DO l=1,ll
[1803]	1078	FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
[1632]	1079	ENDDO
	1080	!$OMP END DO NOWAIT
	1081	ENDIF
	1082	ENDDO
	1083
	1084	END SUBROUTINE Register_SwapField_gen_u
	1085
	1086
	1087
	1088	SUBROUTINE Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,Up,Down,a_request)
[1823]	1089	USE parallel_lmdz
[5272]	1090	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1091	USE paramet_mod_h
[5272]	1092	IMPLICIT NONE
[1632]	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)
[5272]	1150	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	1151	USE lmdz_mpi
[1632]	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)
[5272]	1215	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	1216	USE lmdz_mpi
[1632]	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)
[5272]	1278	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	1279	USE lmdz_mpi
[1632]	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)
[5272]	1341	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1342	USE paramet_mod_h
[5272]	1343	USE lmdz_mpi
[1632]	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
	1372	call allocate_buffer(SizeBuffer,Req%Index,Req%pos)
	1373
	1374	Pos=Req%Pos
	1375	do i=1,Req%NbRequest
	1376	PtrHallo=>Req%Hallo(i)
	1377	offset=(PtrHallo%offset-1)*iip1+1
	1378	Nb=iip1*PtrHallo%size-1
	1379	Field=>PtrHallo%Field
	1380
	1381	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1382	do l=1,PtrHallo%NbLevel
	1383	!cdir NODEP
	1384	do ij=0,Nb
	1385	Buffer(Pos+ij)=Field(Offset+ij,l)
	1386	enddo
	1387
	1388	Pos=Pos+Nb+1
	1389	enddo
	1390	!$OMP END DO NOWAIT
	1391	enddo
	1392
	1393	if (SizeBuffer>0) then
	1394	!$OMP CRITICAL (MPI)
	1395
[2620]	1396	call MPI_ISEND(Buffer(req%Pos),SizeBuffer,MPI_REAL_LMDZ,rank,a_request%tag+1000*omp_rank, &
[1632]	1397	COMM_LMDZ,Req%MSG_Request,ierr)
	1398	IF (.NOT.using_mpi) THEN
	1399	PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
[4469]	1400	CALL abort_gcm("mod_hallo","stopped",1)
[1632]	1401	ENDIF
	1402	! PRINT *,"-------------------------------------------------------------------"
	1403	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
	1404	! PRINT ,"Requete envoye au proc :",rank,"tag :",a_request%tag+1000omp_rank
	1405	! PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
	1406	! PRINT *,"-------------------------------------------------------------------"
	1407	!$OMP END CRITICAL (MPI)
	1408	endif
	1409	endif
	1410	enddo
	1411
	1412
	1413	do rank=0,MPI_SIZE-1
	1414
	1415	Req=>a_Request%RequestRecv(rank)
	1416	SizeBuffer=0
	1417
	1418	do i=1,Req%NbRequest
	1419	PtrHallo=>Req%Hallo(i)
	1420
	1421	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1422	DO l=1,PtrHallo%NbLevel
	1423	SizeBuffer=SizeBuffer+PtrHallo%size*iip1
	1424	ENDDO
	1425	!$OMP ENDDO NOWAIT
	1426	enddo
	1427
	1428	Req%BufferSize=SizeBuffer
	1429
	1430	if (Req%NbRequest>0) then
	1431	call allocate_buffer(SizeBuffer,Req%Index,Req%Pos)
	1432
	1433	if (SizeBuffer>0) then
	1434
	1435	!$OMP CRITICAL (MPI)
	1436
	1437	call MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL_LMDZ,rank,a_request%tag+1000*omp_rank, &
	1438	COMM_LMDZ,Req%MSG_Request,ierr)
[4600]	1439
[1632]	1440	IF (.NOT.using_mpi) THEN
	1441	PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
[4469]	1442	CALL abort_gcm("mod_hallo","stopped",1)
[1632]	1443	ENDIF
	1444
	1445	! PRINT *,"-------------------------------------------------------------------"
	1446	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
	1447	! PRINT ,"Requete en attente du proc :",rank,"tag :",a_request%tag+1000omp_rank
	1448	! PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
	1449	! PRINT *,"-------------------------------------------------------------------"
	1450
	1451	!$OMP END CRITICAL (MPI)
	1452	endif
	1453	endif
	1454
	1455	enddo
	1456
	1457	end subroutine SendRequest
	1458
	1459	subroutine WaitRequest(a_Request)
[5272]	1460	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1461	USE paramet_mod_h
[5272]	1462	USE lmdz_mpi
[1632]	1463	implicit none
	1464
	1465	type(request),target :: a_request
	1466	type(request_SR),pointer :: Req
	1467	type(Hallo),pointer :: PtrHallo
	1468	integer, dimension(2*mpi_size) :: TabRequest
	1469	integer, dimension(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
	1470	integer :: NbRequest
	1471	integer :: i,rank,pos,ij,l,ierr
	1472	integer :: offset
	1473	integer :: Nb
	1474
	1475
	1476	NbRequest=0
	1477	do rank=0,MPI_SIZE-1
	1478	Req=>a_request%RequestSend(rank)
	1479	if (Req%NbRequest>0 .AND. Req%BufferSize > 0) then
	1480	NbRequest=NbRequest+1
	1481	TabRequest(NbRequest)=Req%MSG_Request
	1482	endif
	1483	enddo
	1484
	1485	do rank=0,MPI_SIZE-1
	1486	Req=>a_request%RequestRecv(rank)
	1487	if (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) then
	1488	NbRequest=NbRequest+1
	1489	TabRequest(NbRequest)=Req%MSG_Request
	1490	endif
	1491	enddo
	1492
	1493	if (NbRequest>0) then
	1494	!$OMP CRITICAL (MPI)
	1495	! PRINT *,"-------------------------------------------------------------------"
	1496	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
	1497	! PRINT *,"No des requetes :",TabRequest(1:NbRequest)
	1498	call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
	1499	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
	1500	! PRINT *,"-------------------------------------------------------------------"
	1501	!$OMP END CRITICAL (MPI)
	1502	endif
	1503	do rank=0,MPI_Size-1
	1504	Req=>a_request%RequestRecv(rank)
	1505	if (Req%NbRequest>0) then
	1506	Pos=Req%Pos
	1507	do i=1,Req%NbRequest
	1508	PtrHallo=>Req%Hallo(i)
	1509	offset=(PtrHallo%offset-1)*iip1+1
	1510	Nb=iip1*PtrHallo%size-1
	1511
	1512	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1513	do l=1,PtrHallo%NbLevel
	1514	!cdir NODEP
	1515	do ij=0,Nb
	1516	PtrHallo%Field(offset+ij,l)=Buffer(Pos+ij)
	1517	enddo
	1518
	1519	Pos=Pos+Nb+1
	1520	enddo
	1521	!$OMP ENDDO NOWAIT
	1522	enddo
	1523	endif
	1524	enddo
	1525
	1526	do rank=0,MPI_SIZE-1
	1527	Req=>a_request%RequestSend(rank)
	1528	if (Req%NbRequest>0) then
	1529	call deallocate_buffer(Req%Index)
	1530	Req%NbRequest=0
	1531	endif
	1532	enddo
	1533
	1534	do rank=0,MPI_SIZE-1
	1535	Req=>a_request%RequestRecv(rank)
	1536	if (Req%NbRequest>0) then
	1537	call deallocate_buffer(Req%Index)
	1538	Req%NbRequest=0
	1539	endif
	1540	enddo
	1541
	1542	a_request%tag=1
	1543	end subroutine WaitRequest
	1544
	1545	subroutine WaitSendRequest(a_Request)
[4600]	1546	USE lmdz_mpi
[5272]	1547	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
	1548	implicit none
[1632]	1549
	1550	type(request),target :: a_request
	1551	type(request_SR),pointer :: Req
	1552	type(Hallo),pointer :: PtrHallo
	1553	integer, dimension(mpi_size) :: TabRequest
	1554	integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
	1555	integer :: NbRequest
	1556	integer :: i,rank,pos,ij,l,ierr
	1557	integer :: offset
	1558
	1559
	1560	NbRequest=0
	1561	do rank=0,MPI_SIZE-1
	1562	Req=>a_request%RequestSend(rank)
	1563	if (Req%NbRequest>0) then
	1564	NbRequest=NbRequest+1
	1565	TabRequest(NbRequest)=Req%MSG_Request
	1566	endif
	1567	enddo
	1568
	1569
	1570	if (NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
	1571	!$OMP CRITICAL (MPI)
	1572	! PRINT *,"-------------------------------------------------------------------"
	1573	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
	1574	! PRINT *,"No des requetes :",TabRequest(1:NbRequest)
[4600]	1575	call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
[1632]	1576	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
	1577	! PRINT *,"-------------------------------------------------------------------"
	1578
	1579	!$OMP END CRITICAL (MPI)
	1580	endif
	1581
	1582	do rank=0,MPI_SIZE-1
	1583	Req=>a_request%RequestSend(rank)
	1584	if (Req%NbRequest>0) then
	1585	call deallocate_buffer(Req%Index)
	1586	Req%NbRequest=0
	1587	endif
	1588	enddo
	1589
	1590	a_request%tag=1
	1591	end subroutine WaitSendRequest
	1592
	1593	subroutine WaitRecvRequest(a_Request)
[5272]	1594	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1595	USE paramet_mod_h
[5272]	1596	USE lmdz_mpi
[1632]	1597	implicit none
	1598	type(request),target :: a_request
	1599	type(request_SR),pointer :: Req
	1600	type(Hallo),pointer :: PtrHallo
	1601	integer, dimension(mpi_size) :: TabRequest
	1602	integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
	1603	integer :: NbRequest
	1604	integer :: i,rank,pos,ij,l,ierr
	1605	integer :: offset,Nb
	1606
	1607
	1608	NbRequest=0
	1609
	1610	do rank=0,MPI_SIZE-1
	1611	Req=>a_request%RequestRecv(rank)
	1612	if (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) then
	1613	NbRequest=NbRequest+1
	1614	TabRequest(NbRequest)=Req%MSG_Request
	1615	endif
	1616	enddo
	1617
	1618
	1619	if (NbRequest>0) then
	1620	!$OMP CRITICAL (MPI)
	1621	! PRINT *,"-------------------------------------------------------------------"
	1622	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
	1623	! PRINT *,"No des requetes :",TabRequest(1:NbRequest)
[4600]	1624	call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
[1632]	1625	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
	1626	! PRINT *,"-------------------------------------------------------------------"
	1627	!$OMP END CRITICAL (MPI)
	1628	endif
	1629
	1630	do rank=0,MPI_Size-1
	1631	Req=>a_request%RequestRecv(rank)
	1632	if (Req%NbRequest>0) then
	1633	Pos=Req%Pos
	1634	do i=1,Req%NbRequest
	1635	PtrHallo=>Req%Hallo(i)
	1636	offset=(PtrHallo%offset-1)*iip1+1
	1637	Nb=iip1*PtrHallo%size-1
	1638	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1639	do l=1,PtrHallo%NbLevel
	1640	!cdir NODEP
	1641	do ij=0,Nb
	1642	PtrHallo%Field(offset+ij,l)=Buffer(Pos+ij)
	1643	enddo
	1644	Pos=Pos+Nb+1
	1645	enddo
	1646	!$OMP END DO NOWAIT
	1647	enddo
	1648	endif
	1649	enddo
	1650
	1651
	1652	do rank=0,MPI_SIZE-1
	1653	Req=>a_request%RequestRecv(rank)
	1654	if (Req%NbRequest>0) then
	1655	call deallocate_buffer(Req%Index)
	1656	Req%NbRequest=0
	1657	endif
	1658	enddo
	1659
	1660	a_request%tag=1
	1661	end subroutine WaitRecvRequest
	1662
	1663
	1664
	1665	subroutine CopyField(FieldS,FieldR,ij,ll,jj_Nb_New)
[5271]	1666	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1667	USE paramet_mod_h
[1632]	1668	implicit none
	1669
	1670	INTEGER :: ij,ll,l
	1671	REAL, dimension(ij,ll) :: FieldS
	1672	REAL, dimension(ij,ll) :: FieldR
	1673	integer,dimension(0:MPI_Size-1) :: jj_Nb_New
	1674	integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
	1675
	1676	integer ::i,jje,jjb,ijb,ije
	1677
	1678	jj_begin_New(0)=1
	1679	jj_End_New(0)=jj_Nb_New(0)
	1680	do i=1,MPI_Size-1
	1681	jj_begin_New(i)=jj_end_New(i-1)+1
	1682	jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
	1683	enddo
	1684
	1685	jjb=max(jj_begin,jj_begin_new(MPI_Rank))
	1686	jje=min(jj_end,jj_end_new(MPI_Rank))
	1687	if (ij==ip1jm) jje=min(jje,jjm)
	1688
	1689	if (jje >= jjb) then
	1690	ijb=(jjb-1)*iip1+1
	1691	ije=jje*iip1
	1692
	1693	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1694	do l=1,ll
	1695	FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
	1696	enddo
	1697	!$OMP ENDDO NOWAIT
	1698	endif
	1699
	1700
	1701	end subroutine CopyField
	1702
	1703	subroutine CopyFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down)
[5272]	1704	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1705	USE paramet_mod_h
[1632]	1706	implicit none
	1707
	1708	INTEGER :: ij,ll,Up,Down
	1709	REAL, dimension(ij,ll) :: FieldS
	1710	REAL, dimension(ij,ll) :: FieldR
	1711	integer,dimension(0:MPI_Size-1) :: jj_Nb_New
	1712	integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
	1713
	1714	integer ::i,jje,jjb,ijb,ije,l
	1715
	1716
	1717	jj_begin_New(0)=1
	1718	jj_End_New(0)=jj_Nb_New(0)
	1719	do i=1,MPI_Size-1
	1720	jj_begin_New(i)=jj_end_New(i-1)+1
	1721	jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
	1722	enddo
	1723
	1724
	1725	jjb=max(jj_begin,jj_begin_new(MPI_Rank)-Up)
	1726	jje=min(jj_end,jj_end_new(MPI_Rank)+Down)
	1727	if (ij==ip1jm) jje=min(jje,jjm)
	1728
	1729
	1730	if (jje >= jjb) then
	1731	ijb=(jjb-1)*iip1+1
	1732	ije=jje*iip1
	1733
	1734	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1735	do l=1,ll
	1736	FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
	1737	enddo
	1738	!$OMP ENDDO NOWAIT
	1739
	1740	endif
	1741	end subroutine CopyFieldHallo
	1742
	1743	subroutine Gather_field_u(field_loc,field_glo,ll)
[5272]	1744	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1745	USE paramet_mod_h
[5272]	1746	implicit none
[1632]	1747	integer :: ll
	1748	real :: field_loc(ijb_u:ije_u,ll)
	1749	real :: field_glo(ip1jmp1,ll)
	1750	type(request) :: request_gather
	1751	integer :: l
	1752
	1753
	1754	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1755	DO l=1,ll
	1756	field_glo(ij_begin:ij_end,l)=field_loc(ij_begin:ij_end,l)
	1757	ENDDO
	1758
	1759	call register_SwapField(field_glo,field_glo,ip1jmp1,ll,distrib_gather%jj_nb_para,request_gather)
	1760	call SendRequest(request_gather)
	1761	!$OMP BARRIER
	1762	call WaitRequest(request_gather)
	1763	!$OMP BARRIER
	1764
	1765	end subroutine Gather_field_u
	1766
	1767	subroutine Gather_field_v(field_loc,field_glo,ll)
[5272]	1768	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1769	USE paramet_mod_h
[5272]	1770	implicit none
[1632]	1771	integer :: ll
	1772	real :: field_loc(ijb_v:ije_v,ll)
	1773	real :: field_glo(ip1jm,ll)
	1774	type(request) :: request_gather
	1775	integer :: ijb,ije
	1776	integer :: l
	1777
	1778
	1779	ijb=ij_begin
	1780	ije=ij_end
	1781	if (pole_sud) ije=ij_end-iip1
	1782
	1783	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1784	DO l=1,ll
	1785	field_glo(ijb:ije,l)=field_loc(ijb:ije,l)
	1786	ENDDO
	1787
	1788	call register_SwapField(field_glo,field_glo,ip1jm,ll,distrib_gather%jj_nb_para,request_gather)
	1789	call SendRequest(request_gather)
	1790	!$OMP BARRIER
	1791	call WaitRequest(request_gather)
	1792	!$OMP BARRIER
	1793
	1794	end subroutine Gather_field_v
	1795
	1796	subroutine Scatter_field_u(field_glo,field_loc,ll)
[5272]	1797	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1798	USE paramet_mod_h
[5272]	1799	implicit none
[1632]	1800	integer :: ll
	1801	real :: field_glo(ip1jmp1,ll)
	1802	real :: field_loc(ijb_u:ije_u,ll)
	1803	type(request) :: request_gather
	1804	TYPE(distrib) :: distrib_swap
	1805	integer :: l
	1806
	1807	!$OMP BARRIER
	1808	!$OMP MASTER
	1809	call get_current_distrib(distrib_swap)
	1810	call set_Distrib(distrib_gather)
	1811	!$OMP END MASTER
	1812	!$OMP BARRIER
	1813
	1814	call register_SwapField(field_glo,field_glo,ip1jmp1,ll,distrib_swap%jj_nb_para,request_gather)
	1815	call SendRequest(request_gather)
	1816	!$OMP BARRIER
	1817	call WaitRequest(request_gather)
	1818	!$OMP BARRIER
	1819	!$OMP MASTER
	1820	call set_Distrib(distrib_swap)
	1821	!$OMP END MASTER
	1822	!$OMP BARRIER
	1823
	1824	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1825	DO l=1,ll
	1826	field_loc(ij_begin:ij_end,l)=field_glo(ij_begin:ij_end,l)
	1827	ENDDO
	1828
	1829	end subroutine Scatter_field_u
	1830
	1831	subroutine Scatter_field_v(field_glo,field_loc,ll)
[5272]	1832	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]	1833	USE paramet_mod_h
[5272]	1834	implicit none
[1632]	1835	integer :: ll
	1836	real :: field_glo(ip1jmp1,ll)
	1837	real :: field_loc(ijb_v:ije_v,ll)
	1838	type(request) :: request_gather
	1839	TYPE(distrib) :: distrib_swap
	1840	integer :: ijb,ije,l
	1841
	1842
	1843	!$OMP BARRIER
	1844	!$OMP MASTER
	1845	call get_current_distrib(distrib_swap)
	1846	call set_Distrib(distrib_gather)
	1847	!$OMP END MASTER
	1848	!$OMP BARRIER
	1849	call register_SwapField(field_glo,field_glo,ip1jm,ll,distrib_swap%jj_nb_para,request_gather)
	1850	call SendRequest(request_gather)
	1851	!$OMP BARRIER
	1852	call WaitRequest(request_gather)
	1853	!$OMP BARRIER
	1854	!$OMP MASTER
	1855	call set_Distrib(distrib_swap)
	1856	!$OMP END MASTER
	1857	!$OMP BARRIER
	1858	ijb=ij_begin
	1859	ije=ij_end
	1860	if (pole_sud) ije=ij_end-iip1
	1861
	1862	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1863	DO l=1,ll
	1864	field_loc(ijb:ije,l)=field_glo(ijb:ije,l)
	1865	ENDDO
	1866
	1867	end subroutine Scatter_field_v
	1868
	1869	end module mod_Hallo
	1870

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

Download in other formats:

Original Format