Context Navigation

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

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

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
[1810]	70	USE dimensions_mod
[1847]	71	USE IOIPSL
[1632]	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
[1847]	78	!$OMP MASTER
	79	MaxBufferSize=DefaultMaxBufferSize
	80	CALL getin("mpi_buffer_size",MaxBufferSize)
	81	!$OMP END MASTER
	82	!$OMP BARRIER
	83
[1632]	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
[1803]	90	!$OMP MASTER
[1632]	91	jj_nb_gather(:)=0
	92	jj_nb_gather(0)=jjp1
	93
	94	CALL create_distrib(jj_nb_gather,distrib_gather)
[1803]	95	!$OMP END MASTER
	96	!$OMP BARRIER
[1847]	97
[1632]	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
[4600]	108	USE lmdz_mpi
[1632]	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 !!!!'
[4469]	148	CALL abort_gcm("mod_hallo","stopped",1)
[1632]	149	endif
	150
	151	if (Index_pos>=ListSize) then
	152	print *,'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
[4469]	153	CALL abort_gcm("mod_hallo","stopped",1)
[1632]	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
[1847]	184	subroutine New_Hallo(Field,Stride,NbLevel,offset,size,Ptr_request)
[1632]	185	integer :: Stride
	186	integer :: NbLevel
	187	integer :: size
	188	integer :: offset
	189	real, dimension(Stride,NbLevel),target :: Field
[1847]	190	type(request_SR),pointer :: Ptr_request
	191	type(Hallo),POINTER :: NewHallos(:),HalloSwitch(:), NewHallo
[1632]	192
[1847]	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
[1632]	208	NewHallo%Field=>Field
	209	NewHallo%Stride=Stride
	210	NewHallo%NbLevel=NbLevel
	211	NewHallo%size=size
	212	NewHallo%offset=offset
	213
[1847]	214	end subroutine New_Hallo
[1632]	215
	216	subroutine Register_SendField(Field,ij,ll,offset,size,target,a_request)
[1810]	217	USE dimensions_mod
[1632]	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)
[1847]	227
	228	call New_Hallo(Field,ij,ll,offset,size,Ptr_request)
[1632]	229
	230	end subroutine Register_SendField
	231
	232	subroutine Register_RecvField(Field,ij,ll,offset,size,target,a_request)
[1810]	233	USE dimensions_mod
[1632]	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
[1847]	244	call New_Hallo(Field,ij,ll,offset,size,Ptr_request)
[1632]	245
	246
	247	end subroutine Register_RecvField
	248
	249	subroutine Register_SwapField(FieldS,FieldR,ij,ll,jj_Nb_New,a_request)
[1810]	250	USE dimensions_mod
[1632]	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)
[1810]	298	USE dimensions_mod
[1632]	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
[2436]	350	SUBROUTINE Register_SwapField1d_u(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	351	USE parallel_lmdz
[1810]	352	USE dimensions_mod
[1632]	353	IMPLICIT NONE
	354
	355	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	356	REAL, DIMENSION(current_dist%ijb_u:),INTENT(IN) :: FieldS
	357	REAL, DIMENSION(new_dist%ijb_u:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	371	CALL Register_SwapField_gen_u(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	372
	373	END SUBROUTINE Register_SwapField1d_u
	374
[2436]	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
[1632]	387
[2436]	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)
[1823]	403	USE parallel_lmdz
[1810]	404	USE dimensions_mod
[1632]	405	IMPLICIT NONE
	406
	407	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	408	REAL, DIMENSION(current_dist%ijb_u:,:),INTENT(IN) :: FieldS
	409	REAL, DIMENSION(new_dist%ijb_u:,:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	426	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	427
	428	END SUBROUTINE Register_SwapField2d_u1d
[2436]	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
[1632]	458
	459
[2436]	460	SUBROUTINE Register_SwapField3d_u(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	461	USE parallel_lmdz
[1810]	462	USE dimensions_mod
[1632]	463	IMPLICIT NONE
	464
	465	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	466	REAL, DIMENSION(current_dist%ijb_u:,:,:),INTENT(IN) :: FieldS
	467	REAL, DIMENSION(new_dist%ijb_u:,:,:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	484	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	485
	486	END SUBROUTINE Register_SwapField3d_u
[2436]	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
[1632]	516
	517
	518
[2436]	519	SUBROUTINE Register_SwapField1d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	520	USE parallel_lmdz
[1810]	521	USE dimensions_mod
[1632]	522
	523	IMPLICIT NONE
[2436]	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
[1632]	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
[2436]	541	CALL Register_SwapField_gen_u(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	542
	543	END SUBROUTINE Register_SwapField1d_u2d
	544
[2436]	545	SUBROUTINE Register_SwapField1d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
	546	USE parallel_lmdz
	547	USE dimensions_mod
[1632]	548
[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
[1810]	575	USE dimensions_mod
[1632]	576
	577	IMPLICIT NONE
	578
	579	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	580	REAL, DIMENSION(current_dist%jjb_u:,:,:),INTENT(IN) :: FieldS
	581	REAL, DIMENSION(new_dist%jjb_u:,:,:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	598	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	599
	600	END SUBROUTINE Register_SwapField2d_u2d
[2436]	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
[1632]	631
	632
[2436]	633	SUBROUTINE Register_SwapField3d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	634	USE parallel_lmdz
[1810]	635	USE dimensions_mod
[1632]	636	IMPLICIT NONE
	637
	638	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	639	REAL, DIMENSION(current_dist%jjb_u:,:,:,:),INTENT(IN) :: FieldS
	640	REAL, DIMENSION(new_dist%jjb_u:,:,:,:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	657	CALL Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	658
	659	END SUBROUTINE Register_SwapField3d_u2d
	660
[2436]	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
[1632]	673
[2436]	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
[1632]	689
	690
	691
	692
	693
[2436]	694
	695
	696	SUBROUTINE Register_SwapField1d_v(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	697	USE parallel_lmdz
[1810]	698	USE dimensions_mod
[1632]	699	IMPLICIT NONE
	700
	701	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	702	REAL, DIMENSION(current_dist%ijb_v:),INTENT(IN) :: FieldS
	703	REAL, DIMENSION(new_dist%ijb_v:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	717	CALL Register_SwapField_gen_v(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	718
	719	END SUBROUTINE Register_SwapField1d_v
	720
[2436]	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
[1632]	733
[2436]	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)
[1823]	749	USE parallel_lmdz
[1810]	750	USE dimensions_mod
[1632]	751	IMPLICIT NONE
	752
	753	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	754	REAL, DIMENSION(current_dist%ijb_v:,:),INTENT(IN) :: FieldS
	755	REAL, DIMENSION(new_dist%ijb_v:,:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	772	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	773
	774	END SUBROUTINE Register_SwapField2d_v1d
[2436]	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
[1632]	780
[2436]	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
[1632]	788
[2436]	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)
[1823]	808	USE parallel_lmdz
[1810]	809	USE dimensions_mod
[1632]	810	IMPLICIT NONE
	811
	812	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	813	REAL, DIMENSION(current_dist%ijb_v:,:,:),INTENT(IN) :: FieldS
	814	REAL, DIMENSION(new_dist%ijb_v:,:,:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	831	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	832
	833	END SUBROUTINE Register_SwapField3d_v
	834
[2436]	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
[1632]	847
[2436]	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
[1632]	863
	864
[2436]	865
	866
	867	SUBROUTINE Register_SwapField1d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
[1823]	868	USE parallel_lmdz
[1810]	869	USE dimensions_mod
[1632]	870	IMPLICIT NONE
	871
[2436]	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
[1632]	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
[2436]	888	CALL Register_SwapField_gen_v(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	889
	890	END SUBROUTINE Register_SwapField1d_v2d
	891
[2436]	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
[1632]	904
[2436]	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)
[1823]	920	USE parallel_lmdz
[1810]	921	USE dimensions_mod
[1632]	922	IMPLICIT NONE
	923
	924	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	925	REAL, DIMENSION(current_dist%jjb_v:,:,:),INTENT(IN) :: FieldS
	926	REAL, DIMENSION(new_dist%jjb_v:,:,:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	943	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	944
	945	END SUBROUTINE Register_SwapField2d_v2d
	946
[2436]	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
[1632]	959
[2436]	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)
[1823]	978	USE parallel_lmdz
[1810]	979	USE dimensions_mod
[1632]	980	IMPLICIT NONE
	981
	982	TYPE(distrib),INTENT(IN) :: new_dist
[2436]	983	REAL, DIMENSION(current_dist%jjb_v:,:,:,:),INTENT(IN) :: FieldS
	984	REAL, DIMENSION(new_dist%jjb_v:,:,:,:),INTENT(OUT) :: FieldR
[1632]	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
[2436]	1001	CALL Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
[1632]	1002
	1003	END SUBROUTINE Register_SwapField3d_v2d
	1004
[2436]	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
[1632]	1033
[2436]	1034
[1632]	1035
	1036	SUBROUTINE Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,Up,Down,a_request)
[1823]	1037	USE parallel_lmdz
[1810]	1038	USE dimensions_mod
[1632]	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
[1803]	1079	FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
[1632]	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)
[1823]	1090	USE parallel_lmdz
[1810]	1091	USE dimensions_mod
[1632]	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)
[1810]	1150	USE dimensions_mod
[4600]	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)
[1810]	1215	USE dimensions_mod
[4600]	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)
[1810]	1278	USE dimensions_mod
[4600]	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)
[1810]	1341	USE dimensions_mod
[4600]	1342	USE lmdz_mpi
[1632]	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
[2620]	1395	call MPI_ISEND(Buffer(req%Pos),SizeBuffer,MPI_REAL_LMDZ,rank,a_request%tag+1000*omp_rank, &
[1632]	1396	COMM_LMDZ,Req%MSG_Request,ierr)
	1397	IF (.NOT.using_mpi) THEN
	1398	PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
[4469]	1399	CALL abort_gcm("mod_hallo","stopped",1)
[1632]	1400	ENDIF
	1401	! PRINT *,"-------------------------------------------------------------------"
	1402	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
	1403	! PRINT ,"Requete envoye au proc :",rank,"tag :",a_request%tag+1000omp_rank
	1404	! PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
	1405	! PRINT *,"-------------------------------------------------------------------"
	1406	!$OMP END CRITICAL (MPI)
	1407	endif
	1408	endif
	1409	enddo
	1410
	1411
	1412	do rank=0,MPI_SIZE-1
	1413
	1414	Req=>a_Request%RequestRecv(rank)
	1415	SizeBuffer=0
	1416
	1417	do i=1,Req%NbRequest
	1418	PtrHallo=>Req%Hallo(i)
	1419
	1420	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1421	DO l=1,PtrHallo%NbLevel
	1422	SizeBuffer=SizeBuffer+PtrHallo%size*iip1
	1423	ENDDO
	1424	!$OMP ENDDO NOWAIT
	1425	enddo
	1426
	1427	Req%BufferSize=SizeBuffer
	1428
	1429	if (Req%NbRequest>0) then
	1430	call allocate_buffer(SizeBuffer,Req%Index,Req%Pos)
	1431
	1432	if (SizeBuffer>0) then
	1433
	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)
[4600]	1438
[1632]	1439	IF (.NOT.using_mpi) THEN
	1440	PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
[4469]	1441	CALL abort_gcm("mod_hallo","stopped",1)
[1632]	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+1000omp_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)
[1810]	1459	USE dimensions_mod
[4600]	1460	USE lmdz_mpi
[1632]	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)
[4600]	1544	USE lmdz_mpi
[1810]	1545	USE dimensions_mod
[1632]	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)
[4600]	1573	call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
[1632]	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)
[1810]	1592	USE dimensions_mod
[4600]	1593	USE lmdz_mpi
[1632]	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)
[4600]	1621	call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
[1632]	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)
[1810]	1663	USE dimensions_mod
[1632]	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)
[1810]	1701	USE dimensions_mod
[1632]	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)
[1810]	1741	USE dimensions_mod
[1632]	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)
[1810]	1764	USE dimensions_mod
[1632]	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)
[1810]	1792	USE dimensions_mod
[1632]	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)
[1810]	1826	USE dimensions_mod
[1632]	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
	1862	end module mod_Hallo
	1863

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

Download in other formats:

Original Format