Context Navigation

source: codes/icosagcm/devel/src/parallel/transfert_mpi.f90 @ 726

Last change on this file since 726 was 726, checked in by dubos, 6 years ago
devel : backported from trunk commits r707-r711,r713
File size: 62.2 KB

Rev	Line
[26]	1	MODULE transfert_mpi_mod
	2	USE genmod
[151]	3	USE field_mod
[714]	4	IMPLICIT NONE
[26]	5
	6	TYPE array
	7	INTEGER,POINTER :: value(:)
[146]	8	INTEGER,POINTER :: sign(:)
[26]	9	INTEGER :: domain
	10	INTEGER :: rank
[186]	11	INTEGER :: tag
[26]	12	INTEGER :: size
[186]	13	INTEGER :: offset
	14	INTEGER :: ireq
[26]	15	INTEGER,POINTER :: buffer(:)
[186]	16	REAL,POINTER :: buffer_r(:)
[176]	17	INTEGER,POINTER :: src_value(:)
[26]	18	END TYPE array
[151]	19
	20	TYPE t_buffer
[186]	21	REAL,POINTER :: r(:)
	22	INTEGER :: size
	23	INTEGER :: rank
[151]	24	END TYPE t_buffer
[26]	25
	26	TYPE t_request
	27	INTEGER :: type_field
	28	INTEGER :: max_size
	29	INTEGER :: size
[146]	30	LOGICAL :: vector
[26]	31	INTEGER,POINTER :: src_domain(:)
	32	INTEGER,POINTER :: src_i(:)
	33	INTEGER,POINTER :: src_j(:)
	34	INTEGER,POINTER :: src_ind(:)
	35	INTEGER,POINTER :: target_ind(:)
	36	INTEGER,POINTER :: target_i(:)
	37	INTEGER,POINTER :: target_j(:)
[146]	38	INTEGER,POINTER :: target_sign(:)
[26]	39	INTEGER :: nrecv
	40	TYPE(ARRAY),POINTER :: recv(:)
	41	INTEGER :: nsend
[176]	42	INTEGER :: nreq_mpi
[186]	43	INTEGER :: nreq_send
	44	INTEGER :: nreq_recv
[26]	45	TYPE(ARRAY),POINTER :: send(:)
	46	END TYPE t_request
	47
[186]	48	TYPE(t_request),SAVE,POINTER :: req_i1(:)
	49	TYPE(t_request),SAVE,POINTER :: req_e1_scal(:)
	50	TYPE(t_request),SAVE,POINTER :: req_e1_vect(:)
[726]	51	TYPE(t_request),SAVE,POINTER :: req_z1_scal(:)
[26]	52
[186]	53	TYPE(t_request),SAVE,POINTER :: req_i0(:)
	54	TYPE(t_request),SAVE,POINTER :: req_e0_scal(:)
	55	TYPE(t_request),SAVE,POINTER :: req_e0_vect(:)
	56
	57	TYPE t_reorder
	58	INTEGER :: ind
	59	INTEGER :: rank
	60	INTEGER :: tag
	61	INTEGER :: isend
	62	END TYPE t_reorder
[26]	63
[151]	64	TYPE t_message
[364]	65	CHARACTER(LEN=100) :: name ! for debug
[151]	66	TYPE(t_request), POINTER :: request(:)
	67	INTEGER :: nreq
[186]	68	INTEGER :: nreq_send
	69	INTEGER :: nreq_recv
	70	TYPE(t_reorder), POINTER :: reorder(:)
[151]	71	INTEGER, POINTER :: mpi_req(:)
	72	INTEGER, POINTER :: status(:,:)
	73	TYPE(t_buffer),POINTER :: buffers(:)
	74	TYPE(t_field),POINTER :: field(:)
	75	LOGICAL :: completed
	76	LOGICAL :: pending
[364]	77	LOGICAL :: open ! for debug
[176]	78	INTEGER :: number
[151]	79	END TYPE t_message
[266]	80
	81
	82	INTERFACE bcast_mpi
	83	MODULE PROCEDURE bcast_mpi_c, &
	84	bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
	85	bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
	86	bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
	87	END INTERFACE
	88
[26]	89	CONTAINS
[186]	90
	91
[26]	92	SUBROUTINE init_transfert
[714]	93	USE profiling_mod
[26]	94	USE domain_mod
	95	USE dimensions
	96	USE field_mod
	97	USE metric
	98	USE mpipara
[186]	99	USE mpi_mod
[26]	100	IMPLICIT NONE
	101	INTEGER :: ind,i,j
[186]	102	LOGICAL ::ok
[714]	103
	104	CALL register_id('MPI', id_mpi)
	105
[26]	106	CALL create_request(field_t,req_i1)
	107
	108	DO ind=1,ndomain
	109	CALL swap_dimensions(ind)
	110	DO i=ii_begin,ii_end+1
	111	CALL request_add_point(ind,i,jj_begin-1,req_i1)
	112	ENDDO
	113
	114	DO j=jj_begin,jj_end
	115	CALL request_add_point(ind,ii_end+1,j,req_i1)
	116	ENDDO
	117	DO i=ii_begin,ii_end
	118	CALL request_add_point(ind,i,jj_end+1,req_i1)
	119	ENDDO
	120
	121	DO j=jj_begin,jj_end+1
	122	CALL request_add_point(ind,ii_begin-1,j,req_i1)
	123	ENDDO
	124
	125	ENDDO
	126
	127	CALL finalize_request(req_i1)
[148]	128
	129
	130	CALL create_request(field_t,req_i0)
	131
	132	DO ind=1,ndomain
	133	CALL swap_dimensions(ind)
	134
	135	DO i=ii_begin,ii_end
	136	CALL request_add_point(ind,i,jj_begin,req_i0)
	137	ENDDO
	138
	139	DO j=jj_begin,jj_end
	140	CALL request_add_point(ind,ii_end,j,req_i0)
	141	ENDDO
	142
	143	DO i=ii_begin,ii_end
	144	CALL request_add_point(ind,i,jj_end,req_i0)
	145	ENDDO
	146
	147	DO j=jj_begin,jj_end
	148	CALL request_add_point(ind,ii_begin,j,req_i0)
	149	ENDDO
	150
	151	ENDDO
	152
	153	CALL finalize_request(req_i0)
	154
	155
[146]	156	CALL create_request(field_u,req_e1_scal)
[26]	157	DO ind=1,ndomain
	158	CALL swap_dimensions(ind)
	159	DO i=ii_begin,ii_end
[146]	160	CALL request_add_point(ind,i,jj_begin-1,req_e1_scal,rup)
	161	CALL request_add_point(ind,i+1,jj_begin-1,req_e1_scal,lup)
[26]	162	ENDDO
	163
	164	DO j=jj_begin,jj_end
[146]	165	CALL request_add_point(ind,ii_end+1,j,req_e1_scal,left)
[327]	166	ENDDO
	167	DO j=jj_begin,jj_end
[146]	168	CALL request_add_point(ind,ii_end+1,j-1,req_e1_scal,lup)
[26]	169	ENDDO
	170
	171	DO i=ii_begin,ii_end
[146]	172	CALL request_add_point(ind,i,jj_end+1,req_e1_scal,ldown)
	173	CALL request_add_point(ind,i-1,jj_end+1,req_e1_scal,rdown)
[26]	174	ENDDO
	175
	176	DO j=jj_begin,jj_end
[146]	177	CALL request_add_point(ind,ii_begin-1,j,req_e1_scal,right)
[327]	178	ENDDO
	179	DO j=jj_begin,jj_end
[146]	180	CALL request_add_point(ind,ii_begin-1,j+1,req_e1_scal,rdown)
[26]	181	ENDDO
	182
	183	ENDDO
[146]	184
	185	CALL finalize_request(req_e1_scal)
[148]	186
	187
	188	CALL create_request(field_u,req_e0_scal)
	189	DO ind=1,ndomain
	190	CALL swap_dimensions(ind)
	191
	192
	193	DO i=ii_begin+1,ii_end-1
	194	CALL request_add_point(ind,i,jj_begin,req_e0_scal,right)
	195	CALL request_add_point(ind,i,jj_end,req_e0_scal,right)
	196	ENDDO
[146]	197
[148]	198	DO j=jj_begin+1,jj_end-1
	199	CALL request_add_point(ind,ii_begin,j,req_e0_scal,rup)
	200	CALL request_add_point(ind,ii_end,j,req_e0_scal,rup)
	201	ENDDO
	202
	203	CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_scal,left)
	204	CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_scal,ldown)
	205	CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_scal,left)
	206	CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_scal,ldown)
	207
	208	ENDDO
	209
	210	CALL finalize_request(req_e0_scal)
	211
	212
	213
[146]	214	CALL create_request(field_u,req_e1_vect,.TRUE.)
	215	DO ind=1,ndomain
	216	CALL swap_dimensions(ind)
	217	DO i=ii_begin,ii_end
	218	CALL request_add_point(ind,i,jj_begin-1,req_e1_vect,rup)
	219	CALL request_add_point(ind,i+1,jj_begin-1,req_e1_vect,lup)
	220	ENDDO
	221
	222	DO j=jj_begin,jj_end
	223	CALL request_add_point(ind,ii_end+1,j,req_e1_vect,left)
[327]	224	ENDDO
	225	DO j=jj_begin,jj_end
[146]	226	CALL request_add_point(ind,ii_end+1,j-1,req_e1_vect,lup)
	227	ENDDO
	228
	229	DO i=ii_begin,ii_end
	230	CALL request_add_point(ind,i,jj_end+1,req_e1_vect,ldown)
	231	CALL request_add_point(ind,i-1,jj_end+1,req_e1_vect,rdown)
	232	ENDDO
	233
	234	DO j=jj_begin,jj_end
	235	CALL request_add_point(ind,ii_begin-1,j,req_e1_vect,right)
[327]	236	ENDDO
	237	DO j=jj_begin,jj_end
[146]	238	CALL request_add_point(ind,ii_begin-1,j+1,req_e1_vect,rdown)
	239	ENDDO
	240
[26]	241
[146]	242	ENDDO
	243
	244	CALL finalize_request(req_e1_vect)
[148]	245
	246
	247	CALL create_request(field_u,req_e0_vect,.TRUE.)
	248	DO ind=1,ndomain
	249	CALL swap_dimensions(ind)
	250
	251	DO i=ii_begin+1,ii_end-1
	252	CALL request_add_point(ind,i,jj_begin,req_e0_vect,right)
	253	CALL request_add_point(ind,i,jj_end,req_e0_vect,right)
	254	ENDDO
	255
	256	DO j=jj_begin+1,jj_end-1
	257	CALL request_add_point(ind,ii_begin,j,req_e0_vect,rup)
	258	CALL request_add_point(ind,ii_end,j,req_e0_vect,rup)
	259	ENDDO
[146]	260
[148]	261	CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_vect,left)
	262	CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_vect,ldown)
	263	CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_vect,left)
	264	CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_vect,ldown)
	265
	266	ENDDO
	267
	268	CALL finalize_request(req_e0_vect)
	269
[726]	270	CALL create_request(field_z,req_z1_scal)
	271	DO ind=1,ndomain
	272	CALL swap_dimensions(ind)
	273	DO i=ii_begin,ii_end
	274	CALL request_add_point(ind,i,jj_begin-1,req_z1_scal,vrup)
	275	CALL request_add_point(ind,i+1,jj_begin-1,req_z1_scal,vup)
	276	ENDDO
[148]	277
[726]	278	DO j=jj_begin,jj_end
	279	CALL request_add_point(ind,ii_end+1,j,req_z1_scal,vlup)
	280	ENDDO
	281	DO j=jj_begin,jj_end
	282	CALL request_add_point(ind,ii_end+1,j-1,req_z1_scal,vup)
	283	ENDDO
	284
	285	DO i=ii_begin,ii_end
	286	CALL request_add_point(ind,i,jj_end+1,req_z1_scal,vdown)
	287	CALL request_add_point(ind,i-1,jj_end+1,req_z1_scal,vrdown)
	288	ENDDO
	289
	290	DO j=jj_begin,jj_end
	291	CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrup)
	292	ENDDO
	293	DO j=jj_begin,jj_end
	294	CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrdown)
	295	ENDDO
	296
	297	ENDDO
	298
	299	CALL finalize_request(req_z1_scal)
	300
[26]	301	END SUBROUTINE init_transfert
	302
[146]	303	SUBROUTINE create_request(type_field,request,vector)
[26]	304	USE domain_mod
	305	USE field_mod
	306	IMPLICIT NONE
	307	INTEGER :: type_field
	308	TYPE(t_request),POINTER :: request(:)
[146]	309	LOGICAL,OPTIONAL :: vector
	310
[26]	311	TYPE(t_request),POINTER :: req
	312	TYPE(t_domain),POINTER :: d
	313	INTEGER :: ind
	314	INTEGER :: max_size
[146]	315
[26]	316	ALLOCATE(request(ndomain))
	317
	318	DO ind=1,ndomain
	319	req=>request(ind)
	320	d=>domain(ind)
	321	IF (type_field==field_t) THEN
	322	Max_size=2(d%iim+2)+2(d%jjm+2)
	323	ELSE IF (type_field==field_u) THEN
	324	Max_size=3(2(d%iim+2)+2*(d%jjm+2))
	325	ELSE IF (type_field==field_z) THEN
	326	Max_size=2(2(d%iim+2)+2*(d%jjm+2))
	327	ENDIF
	328
	329	req%type_field=type_field
	330	req%max_size=max_size*2
	331	req%size=0
[146]	332	req%vector=.FALSE.
	333	IF (PRESENT(vector)) req%vector=vector
[26]	334	ALLOCATE(req%src_domain(req%max_size))
	335	ALLOCATE(req%src_ind(req%max_size))
	336	ALLOCATE(req%target_ind(req%max_size))
	337	ALLOCATE(req%src_i(req%max_size))
	338	ALLOCATE(req%src_j(req%max_size))
	339	ALLOCATE(req%target_i(req%max_size))
	340	ALLOCATE(req%target_j(req%max_size))
[146]	341	ALLOCATE(req%target_sign(req%max_size))
[26]	342	ENDDO
	343
	344	END SUBROUTINE create_request
	345
	346	SUBROUTINE reallocate_request(req)
	347	IMPLICIT NONE
	348	TYPE(t_request),POINTER :: req
	349
	350	INTEGER,POINTER :: src_domain(:)
	351	INTEGER,POINTER :: src_ind(:)
	352	INTEGER,POINTER :: target_ind(:)
	353	INTEGER,POINTER :: src_i(:)
	354	INTEGER,POINTER :: src_j(:)
	355	INTEGER,POINTER :: target_i(:)
	356	INTEGER,POINTER :: target_j(:)
[146]	357	INTEGER,POINTER :: target_sign(:)
[26]	358
	359	PRINT *,"REALLOCATE_REQUEST"
	360	src_domain=>req%src_domain
	361	src_ind=>req%src_ind
	362	target_ind=>req%target_ind
	363	src_i=>req%src_i
	364	src_j=>req%src_j
	365	target_i=>req%target_i
	366	target_j=>req%target_j
[146]	367	target_sign=>req%target_sign
[151]	368
[26]	369	ALLOCATE(req%src_domain(req%max_size*2))
	370	ALLOCATE(req%src_ind(req%max_size*2))
	371	ALLOCATE(req%target_ind(req%max_size*2))
	372	ALLOCATE(req%src_i(req%max_size*2))
	373	ALLOCATE(req%src_j(req%max_size*2))
	374	ALLOCATE(req%target_i(req%max_size*2))
	375	ALLOCATE(req%target_j(req%max_size*2))
[146]	376	ALLOCATE(req%target_sign(req%max_size*2))
[26]	377
	378	req%src_domain(1:req%max_size)=src_domain(:)
	379	req%src_ind(1:req%max_size)=src_ind(:)
	380	req%target_ind(1:req%max_size)=target_ind(:)
	381	req%src_i(1:req%max_size)=src_i(:)
	382	req%src_j(1:req%max_size)=src_j(:)
	383	req%target_i(1:req%max_size)=target_i(:)
	384	req%target_j(1:req%max_size)=target_j(:)
[146]	385	req%target_sign(1:req%max_size)=target_sign(:)
[26]	386
	387	req%max_size=req%max_size*2
	388
	389	DEALLOCATE(src_domain)
	390	DEALLOCATE(src_ind)
	391	DEALLOCATE(target_ind)
	392	DEALLOCATE(src_i)
	393	DEALLOCATE(src_j)
	394	DEALLOCATE(target_i)
	395	DEALLOCATE(target_j)
[146]	396	DEALLOCATE(target_sign)
[26]	397
	398	END SUBROUTINE reallocate_request
	399
	400
	401	SUBROUTINE request_add_point(ind,i,j,request,pos)
	402	USE domain_mod
	403	USE field_mod
	404	IMPLICIT NONE
	405	INTEGER,INTENT(IN) :: ind
	406	INTEGER,INTENT(IN) :: i
	407	INTEGER,INTENT(IN) :: j
	408	TYPE(t_request),POINTER :: request(:)
	409	INTEGER,INTENT(IN),OPTIONAL :: pos
	410
	411	INTEGER :: src_domain
	412	INTEGER :: src_iim,src_i,src_j,src_n,src_pos,src_delta
	413	TYPE(t_request),POINTER :: req
	414	TYPE(t_domain),POINTER :: d
	415
	416	req=>request(ind)
	417	d=>domain(ind)
	418
	419	IF (req%max_size==req%size) CALL reallocate_request(req)
	420	req%size=req%size+1
	421	IF (req%type_field==field_t) THEN
	422	src_domain=domain(ind)%assign_domain(i,j)
	423	src_iim=domain_glo(src_domain)%iim
	424	src_i=domain(ind)%assign_i(i,j)
	425	src_j=domain(ind)%assign_j(i,j)
	426
	427	req%target_ind(req%size)=(j-1)*d%iim+i
[146]	428	req%target_sign(req%size)=1
[26]	429	req%src_domain(req%size)=src_domain
	430	req%src_ind(req%size)=(src_j-1)*src_iim+src_i
	431	ELSE IF (req%type_field==field_u) THEN
	432	IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
	433
	434	src_domain=domain(ind)%edge_assign_domain(pos-1,i,j)
	435	src_iim=domain_glo(src_domain)%iim
	436	src_i=domain(ind)%edge_assign_i(pos-1,i,j)
	437	src_j=domain(ind)%edge_assign_j(pos-1,i,j)
	438	src_n=(src_j-1)*src_iim+src_i
	439	src_delta=domain(ind)%delta(i,j)
	440	src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1
	441
	442	req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos)
[146]	443
	444	req%target_sign(req%size)= 1
	445	IF (req%vector) req%target_sign(req%size)= domain(ind)%edge_assign_sign(pos-1,i,j)
	446
[26]	447	req%src_domain(req%size)=src_domain
	448	req%src_ind(req%size)=src_n+domain_glo(src_domain)%u_pos(src_pos)
	449
	450	ELSE IF (req%type_field==field_z) THEN
	451	IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
	452
[726]	453	src_domain=domain(ind)%vertex_assign_domain(pos-1,i,j)
[26]	454	src_iim=domain_glo(src_domain)%iim
[726]	455	src_i=domain(ind)%vertex_assign_i(pos-1,i,j)
	456	src_j=domain(ind)%vertex_assign_j(pos-1,i,j)
[26]	457	src_n=(src_j-1)*src_iim+src_i
	458	src_delta=domain(ind)%delta(i,j)
[726]	459	src_pos=domain(ind)%vertex_assign_pos(pos-1,i,j)+1
	460
[26]	461
	462	req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos)
[146]	463	req%target_sign(req%size)=1
[26]	464	req%src_domain(req%size)=src_domain
	465	req%src_ind(req%size)=src_n+domain_glo(src_domain)%z_pos(src_pos)
	466	ENDIF
	467	END SUBROUTINE request_add_point
	468
	469
	470	SUBROUTINE Finalize_request(request)
	471	USE mpipara
	472	USE domain_mod
	473	USE mpi_mod
	474	IMPLICIT NONE
	475	TYPE(t_request),POINTER :: request(:)
[176]	476	TYPE(t_request),POINTER :: req, req_src
[26]	477	INTEGER :: nb_domain_recv(0:mpi_size-1)
	478	INTEGER :: nb_domain_send(0:mpi_size-1)
[186]	479	INTEGER :: tag_rank(0:mpi_size-1)
[26]	480	INTEGER :: nb_data_domain_recv(ndomain_glo)
	481	INTEGER :: list_domain_recv(ndomain_glo)
	482	INTEGER,ALLOCATABLE :: list_domain_send(:)
	483	INTEGER :: list_domain(ndomain)
	484
[186]	485	INTEGER :: rank,i,j,pos
[176]	486	INTEGER :: size_,ind_glo,ind_loc, ind_src
[186]	487	INTEGER :: isend, irecv, ireq, nreq, nsend, nrecv
[26]	488	INTEGER, ALLOCATABLE :: mpi_req(:)
	489	INTEGER, ALLOCATABLE :: status(:,:)
[186]	490	INTEGER, ALLOCATABLE :: rank_list(:)
	491	INTEGER, ALLOCATABLE :: offset(:)
	492	LOGICAL,PARAMETER :: debug = .FALSE.
	493
	494
[26]	495	IF (.NOT. using_mpi) RETURN
	496
	497	DO ind_loc=1,ndomain
	498	req=>request(ind_loc)
	499
	500	nb_data_domain_recv(:) = 0
	501	nb_domain_recv(:) = 0
[186]	502	tag_rank(:)=0
[26]	503
	504	DO i=1,req%size
	505	ind_glo=req%src_domain(i)
	506	nb_data_domain_recv(ind_glo)=nb_data_domain_recv(ind_glo)+1
	507	ENDDO
	508
	509	DO ind_glo=1,ndomain_glo
	510	IF ( nb_data_domain_recv(ind_glo) > 0 ) nb_domain_recv(domglo_rank(ind_glo))=nb_domain_recv(domglo_rank(ind_glo))+1
	511	ENDDO
	512
	513	req%nrecv=sum(nb_domain_recv(:))
	514	ALLOCATE(req%recv(req%nrecv))
	515
	516	irecv=0
	517	DO ind_glo=1,ndomain_glo
	518	IF (nb_data_domain_recv(ind_glo)>0) THEN
	519	irecv=irecv+1
	520	list_domain_recv(ind_glo)=irecv
	521	req%recv(irecv)%rank=domglo_rank(ind_glo)
	522	req%recv(irecv)%size=nb_data_domain_recv(ind_glo)
	523	req%recv(irecv)%domain=domglo_loc_ind(ind_glo)
	524	ALLOCATE(req%recv(irecv)%value(req%recv(irecv)%size))
[146]	525	ALLOCATE(req%recv(irecv)%sign(req%recv(irecv)%size))
[26]	526	ALLOCATE(req%recv(irecv)%buffer(req%recv(irecv)%size))
	527	ENDIF
	528	ENDDO
	529
	530	req%recv(:)%size=0
	531	irecv=0
	532	DO i=1,req%size
	533	irecv=list_domain_recv(req%src_domain(i))
	534	req%recv(irecv)%size=req%recv(irecv)%size+1
[176]	535	size_=req%recv(irecv)%size
	536	req%recv(irecv)%value(size_)=req%src_ind(i)
	537	req%recv(irecv)%buffer(size_)=req%target_ind(i)
	538	req%recv(irecv)%sign(size_)=req%target_sign(i)
[26]	539	ENDDO
	540	ENDDO
	541
	542	nb_domain_recv(:) = 0
	543	DO ind_loc=1,ndomain
	544	req=>request(ind_loc)
	545
	546	DO irecv=1,req%nrecv
	547	rank=req%recv(irecv)%rank
	548	nb_domain_recv(rank)=nb_domain_recv(rank)+1
	549	ENDDO
	550	ENDDO
	551
	552	CALL MPI_Alltoall(nb_domain_recv,1,MPI_INTEGER,nb_domain_send,1,MPI_INTEGER,comm_icosa,ierr)
	553
	554
	555	ALLOCATE(list_domain_send(sum(nb_domain_send)))
	556
	557	nreq=sum(nb_domain_recv(:))+sum(nb_domain_send(:))
	558	ALLOCATE(mpi_req(nreq))
	559	ALLOCATE(status(MPI_STATUS_SIZE,nreq))
	560
[186]	561
[26]	562	ireq=0
	563	DO ind_loc=1,ndomain
	564	req=>request(ind_loc)
	565	DO irecv=1,req%nrecv
	566	ireq=ireq+1
	567	CALL MPI_ISEND(req%recv(irecv)%domain,1,MPI_INTEGER,req%recv(irecv)%rank,0,comm_icosa, mpi_req(ireq),ierr)
[186]	568	IF (debug) PRINT *,"Isend ",req%recv(irecv)%domain, "from ", mpi_rank, "to ",req%recv(irecv)%rank, "tag ",0
[26]	569	ENDDO
	570	ENDDO
[186]	571
	572	IF (debug) PRINT *,"------------"
[26]	573	j=0
	574	DO rank=0,mpi_size-1
	575	DO i=1,nb_domain_send(rank)
	576	j=j+1
	577	ireq=ireq+1
	578	CALL MPI_IRECV(list_domain_send(j),1,MPI_INTEGER,rank,0,comm_icosa, mpi_req(ireq),ierr)
[186]	579	IF (debug) PRINT *,"IRecv ",list_domain_send(j), "from ", rank, "to ",mpi_rank, "tag ",0
[26]	580	ENDDO
	581	ENDDO
[186]	582	IF (debug) PRINT *,"------------"
[26]	583
	584	CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
	585
	586	list_domain(:)=0
	587	DO i=1,sum(nb_domain_send)
	588	ind_loc=list_domain_send(i)
	589	list_domain(ind_loc)=list_domain(ind_loc)+1
	590	ENDDO
	591
	592	DO ind_loc=1,ndomain
	593	req=>request(ind_loc)
	594	req%nsend=list_domain(ind_loc)
	595	ALLOCATE(req%send(req%nsend))
	596	ENDDO
[186]	597
	598	IF (debug) PRINT *,"------------"
[26]	599
	600	ireq=0
	601	DO ind_loc=1,ndomain
	602	req=>request(ind_loc)
	603
	604	DO irecv=1,req%nrecv
	605	ireq=ireq+1
	606	CALL MPI_ISEND(mpi_rank,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
[186]	607	IF (debug) PRINT *,"Isend ",mpi_rank, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
[26]	608	ENDDO
[186]	609	IF (debug) PRINT *,"------------"
[26]	610
	611	DO isend=1,req%nsend
	612	ireq=ireq+1
	613	CALL MPI_IRECV(req%send(isend)%rank,1,MPI_INTEGER,MPI_ANY_SOURCE,ind_loc,comm_icosa, mpi_req(ireq),ierr)
[186]	614	IF (debug) PRINT *,"IRecv ",req%send(isend)%rank, "from ", "xxx", "to ",mpi_rank, "tag ",ind_loc
[26]	615	ENDDO
	616	ENDDO
	617
[186]	618	IF (debug) PRINT *,"------------"
	619
[26]	620	CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
	621	CALL MPI_BARRIER(comm_icosa,ierr)
	622
[186]	623	IF (debug) PRINT *,"------------"
	624
[26]	625	ireq=0
	626	DO ind_loc=1,ndomain
	627	req=>request(ind_loc)
	628
	629	DO irecv=1,req%nrecv
	630	ireq=ireq+1
[176]	631	CALL MPI_ISEND(ind_loc,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
[186]	632	IF (debug) PRINT *,"Isend ",ind_loc, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
[176]	633	ENDDO
[186]	634
	635	IF (debug) PRINT *,"------------"
[176]	636
	637	DO isend=1,req%nsend
	638	ireq=ireq+1
	639	CALL MPI_IRECV(req%send(isend)%domain,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
[186]	640	IF (debug) PRINT *,"IRecv ",req%send(isend)%domain, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
[176]	641	ENDDO
	642	ENDDO
[186]	643	IF (debug) PRINT *,"------------"
[176]	644
	645	CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
	646	CALL MPI_BARRIER(comm_icosa,ierr)
[186]	647	IF (debug) PRINT *,"------------"
[176]	648
[186]	649	ireq=0
	650	DO ind_loc=1,ndomain
	651	req=>request(ind_loc)
	652
	653	DO irecv=1,req%nrecv
	654	ireq=ireq+1
	655	req%recv(irecv)%tag=tag_rank(req%recv(irecv)%rank)
	656	tag_rank(req%recv(irecv)%rank)=tag_rank(req%recv(irecv)%rank)+1
	657	CALL MPI_ISEND(req%recv(irecv)%tag,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
	658	IF (debug) PRINT *,"Isend ",req%recv(irecv)%tag, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
	659	ENDDO
	660	IF (debug) PRINT *,"------------"
	661
	662	DO isend=1,req%nsend
	663	ireq=ireq+1
	664	CALL MPI_IRECV(req%send(isend)%tag,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
	665	IF (debug) PRINT *,"IRecv ",req%send(isend)%tag, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
	666	ENDDO
	667	ENDDO
	668	IF (debug) PRINT *,"------------"
	669
	670	CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
	671	CALL MPI_BARRIER(comm_icosa,ierr)
	672
	673
	674	IF (debug) PRINT *,"------------"
	675
[176]	676	ireq=0
	677	DO ind_loc=1,ndomain
	678	req=>request(ind_loc)
	679
	680	DO irecv=1,req%nrecv
	681	ireq=ireq+1
[186]	682	CALL MPI_ISEND(req%recv(irecv)%size,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
	683	IF (debug) PRINT *,"Isend ",req%recv(irecv)%size, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
[26]	684	ENDDO
[186]	685	IF (debug) PRINT *,"------------"
[26]	686
	687	DO isend=1,req%nsend
	688	ireq=ireq+1
[186]	689	CALL MPI_IRECV(req%send(isend)%size,1,MPI_INTEGER,req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
	690	IF (debug) PRINT *,"IRecv ",req%send(isend)%size, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
[26]	691	ENDDO
	692	ENDDO
	693
	694	CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
	695
	696	ireq=0
	697	DO ind_loc=1,ndomain
	698	req=>request(ind_loc)
	699
	700	DO irecv=1,req%nrecv
	701	ireq=ireq+1
[44]	702	CALL MPI_ISEND(req%recv(irecv)%value,req%recv(irecv)%size,MPI_INTEGER,&
[186]	703	req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
[26]	704	ENDDO
	705
	706	DO isend=1,req%nsend
	707	ireq=ireq+1
	708	ALLOCATE(req%send(isend)%value(req%send(isend)%size))
[44]	709	CALL MPI_IRECV(req%send(isend)%value,req%send(isend)%size,MPI_INTEGER,&
[186]	710	req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
[26]	711	ENDDO
	712	ENDDO
	713
	714	CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
	715
	716	DO ind_loc=1,ndomain
	717	req=>request(ind_loc)
	718
	719	DO irecv=1,req%nrecv
	720	req%recv(irecv)%value(:)=req%recv(irecv)%buffer(:)
[146]	721	req%recv(irecv)%sign(:) =req%recv(irecv)%sign(:)
[26]	722	DEALLOCATE(req%recv(irecv)%buffer)
	723	ENDDO
	724	ENDDO
[186]	725
[176]	726
[186]	727	! domain is on the same mpi process => copie memory to memory
[26]	728
[176]	729	DO ind_loc=1,ndomain
	730	req=>request(ind_loc)
	731
	732	DO irecv=1,req%nrecv
	733
	734	IF (req%recv(irecv)%rank==mpi_rank) THEN
	735	req_src=>request(req%recv(irecv)%domain)
	736	DO isend=1,req_src%nsend
[186]	737	IF (req_src%send(isend)%rank==mpi_rank .AND. req_src%send(isend)%tag==req%recv(irecv)%tag) THEN
[176]	738	req%recv(irecv)%src_value => req_src%send(isend)%value
	739	IF ( size(req%recv(irecv)%value) /= size(req_src%send(isend)%value)) THEN
[186]	740	PRINT *,ind_loc, irecv, isend, size(req%recv(irecv)%value), size(req_src%send(isend)%value)
[176]	741	STOP "size(req%recv(irecv)%value) /= size(req_src%send(isend)%value"
	742	ENDIF
	743	ENDIF
	744	ENDDO
	745	ENDIF
	746
	747	ENDDO
	748	ENDDO
	749
	750	! true number of mpi request
[186]	751
	752	request(:)%nreq_mpi=0
	753	request(:)%nreq_send=0
	754	request(:)%nreq_recv=0
	755	ALLOCATE(rank_list(sum(request(:)%nsend)))
	756	ALLOCATE(offset(sum(request(:)%nsend)))
	757	offset(:)=0
	758
	759	nsend=0
[176]	760	DO ind_loc=1,ndomain
	761	req=>request(ind_loc)
	762
	763	DO isend=1,req%nsend
[186]	764	IF (req%send(isend)%rank/=mpi_rank) THEN
	765	pos=0
	766	DO i=1,nsend
	767	IF (req%send(isend)%rank==rank_list(i)) EXIT
	768	pos=pos+1
	769	ENDDO
	770
	771	IF (pos==nsend) THEN
	772	nsend=nsend+1
	773	req%nreq_mpi=req%nreq_mpi+1
	774	req%nreq_send=req%nreq_send+1
[193]	775	IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
[186]	776	rank_list(nsend)=req%send(isend)%rank
	777	ELSE
	778	rank_list(nsend)=-1
	779	ENDIF
	780	ENDIF
	781
	782	pos=pos+1
	783	req%send(isend)%ireq=pos
	784	req%send(isend)%offset=offset(pos)
	785	offset(pos)=offset(pos)+req%send(isend)%size
	786	ENDIF
[176]	787	ENDDO
[186]	788	ENDDO
	789
	790	DEALLOCATE(rank_list)
	791	DEALLOCATE(offset)
[176]	792
[186]	793	ALLOCATE(rank_list(sum(request(:)%nrecv)))
	794	ALLOCATE(offset(sum(request(:)%nrecv)))
	795	offset(:)=0
	796
	797	nrecv=0
	798	DO ind_loc=1,ndomain
	799	req=>request(ind_loc)
	800
[176]	801	DO irecv=1,req%nrecv
[186]	802	IF (req%recv(irecv)%rank/=mpi_rank) THEN
	803	pos=0
	804	DO i=1,nrecv
	805	IF (req%recv(irecv)%rank==rank_list(i)) EXIT
	806	pos=pos+1
	807	ENDDO
	808
	809	IF (pos==nrecv) THEN
	810	nrecv=nrecv+1
	811	req%nreq_mpi=req%nreq_mpi+1
	812	req%nreq_recv=req%nreq_recv+1
[193]	813	IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
[186]	814	rank_list(nrecv)=req%recv(irecv)%rank
	815	ELSE
	816	rank_list(nrecv)=-1
	817	ENDIF
	818	ENDIF
	819
	820	pos=pos+1
	821	req%recv(irecv)%ireq=nsend+pos
	822	req%recv(irecv)%offset=offset(pos)
	823	offset(pos)=offset(pos)+req%recv(irecv)%size
	824	ENDIF
[176]	825	ENDDO
	826	ENDDO
[186]	827
	828	! get the offsets
	829
	830	ireq=0
	831	DO ind_loc=1,ndomain
	832	req=>request(ind_loc)
	833
	834	DO irecv=1,req%nrecv
	835	ireq=ireq+1
	836	CALL MPI_ISEND(req%recv(irecv)%offset,1,MPI_INTEGER,&
	837	req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
	838	ENDDO
	839
	840	DO isend=1,req%nsend
	841	ireq=ireq+1
	842	CALL MPI_IRECV(req%send(isend)%offset,1,MPI_INTEGER,&
	843	req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
	844	ENDDO
	845	ENDDO
	846
	847	CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
	848
[176]	849
[146]	850	END SUBROUTINE Finalize_request
[26]	851
	852
[364]	853	SUBROUTINE init_message_seq(field, request, message, name)
[151]	854	USE field_mod
	855	USE domain_mod
	856	USE mpi_mod
	857	USE mpipara
	858	USE mpi_mod
	859	IMPLICIT NONE
	860	TYPE(t_field),POINTER :: field(:)
	861	TYPE(t_request),POINTER :: request(:)
	862	TYPE(t_message) :: message
[364]	863	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
[151]	864	!$OMP MASTER
	865	message%request=>request
[364]	866	IF(PRESENT(name)) THEN
	867	message%name = TRIM(name)
	868	ELSE
	869	message%name = 'unknown'
	870	END IF
[151]	871	!$OMP END MASTER
	872	!$OMP BARRIER
	873
	874	END SUBROUTINE init_message_seq
	875
	876	SUBROUTINE send_message_seq(field,message)
	877	USE field_mod
	878	USE domain_mod
	879	USE mpi_mod
	880	USE mpipara
	881	USE omp_para
	882	USE trace
	883	IMPLICIT NONE
	884	TYPE(t_field),POINTER :: field(:)
	885	TYPE(t_message) :: message
	886
	887	CALL transfert_request_seq(field,message%request)
	888
	889	END SUBROUTINE send_message_seq
	890
	891	SUBROUTINE test_message_seq(message)
	892	IMPLICIT NONE
	893	TYPE(t_message) :: message
	894	END SUBROUTINE test_message_seq
	895
	896
	897	SUBROUTINE wait_message_seq(message)
	898	IMPLICIT NONE
	899	TYPE(t_message) :: message
	900
	901	END SUBROUTINE wait_message_seq
	902
	903	SUBROUTINE transfert_message_seq(field,message)
	904	USE field_mod
	905	USE domain_mod
	906	USE mpi_mod
	907	USE mpipara
	908	USE omp_para
	909	USE trace
	910	IMPLICIT NONE
	911	TYPE(t_field),POINTER :: field(:)
	912	TYPE(t_message) :: message
	913
	914	CALL send_message_seq(field,message)
	915
	916	END SUBROUTINE transfert_message_seq
	917
[186]	918
	919
[151]	920
[364]	921	SUBROUTINE init_message_mpi(field,request, message, name)
[151]	922	USE field_mod
	923	USE domain_mod
	924	USE mpi_mod
	925	USE mpipara
	926	USE mpi_mod
	927	IMPLICIT NONE
	928
	929	TYPE(t_field),POINTER :: field(:)
	930	TYPE(t_request),POINTER :: request(:)
	931	TYPE(t_message) :: message
[364]	932	CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: name
[151]	933
	934	TYPE(ARRAY),POINTER :: recv,send
	935	TYPE(t_request),POINTER :: req
	936	INTEGER :: irecv,isend
[186]	937	INTEGER :: ireq,nreq, nreq_send
[151]	938	INTEGER :: ind
	939	INTEGER :: dim3,dim4
[186]	940	INTEGER :: i,j
[188]	941	INTEGER,SAVE :: message_number=0
[186]	942	! TYPE(t_reorder),POINTER :: reorder(:)
	943	! TYPE(t_reorder) :: reorder_swap
[151]	944
[186]	945	!$OMP BARRIER
[151]	946	!$OMP MASTER
[364]	947	IF(PRESENT(name)) THEN
	948	message%name = TRIM(name)
	949	ELSE
	950	message%name = 'unknown'
	951	END IF
[176]	952	message%number=message_number
	953	message_number=message_number+1
	954	IF (message_number==100) message_number=0
[186]	955
	956
[151]	957	message%request=>request
[176]	958	message%nreq=sum(message%request(:)%nreq_mpi)
[186]	959	message%nreq_send=sum(message%request(:)%nreq_send)
	960	message%nreq_recv=sum(message%request(:)%nreq_recv)
	961	nreq=message%nreq
	962
[151]	963	ALLOCATE(message%mpi_req(nreq))
	964	ALLOCATE(message%buffers(nreq))
	965	ALLOCATE(message%status(MPI_STATUS_SIZE,nreq))
[186]	966	message%buffers(:)%size=0
[151]	967	message%pending=.FALSE.
	968	message%completed=.FALSE.
[364]	969	message%open=.FALSE.
	970
[186]	971	DO ind=1,ndomain
	972	req=>request(ind)
	973	DO isend=1,req%nsend
	974	IF (req%send(isend)%rank/=mpi_rank) THEN
	975	ireq=req%send(isend)%ireq
	976	message%buffers(ireq)%size=message%buffers(ireq)%size+req%send(isend)%size
	977	message%buffers(ireq)%rank=req%send(isend)%rank
	978	ENDIF
	979	ENDDO
	980	DO irecv=1,req%nrecv
	981	IF (req%recv(irecv)%rank/=mpi_rank) THEN
	982	ireq=req%recv(irecv)%ireq
	983	message%buffers(ireq)%size=message%buffers(ireq)%size+req%recv(irecv)%size
	984	message%buffers(ireq)%rank=req%recv(irecv)%rank
	985	ENDIF
	986	ENDDO
	987	ENDDO
	988
	989
[151]	990	IF (field(1)%data_type==type_real) THEN
	991
	992	IF (field(1)%ndim==2) THEN
[186]	993
	994	DO ireq=1,message%nreq
	995	CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
	996	ENDDO
[151]	997
[186]	998	ELSE IF (field(1)%ndim==3) THEN
[151]	999
[186]	1000	dim3=size(field(1)%rval3d,2)
	1001	DO ireq=1,message%nreq
	1002	message%buffers(ireq)%size=message%buffers(ireq)%size*dim3
	1003	CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
[151]	1004	ENDDO
	1005
[186]	1006	ELSE IF (field(1)%ndim==4) THEN
	1007	dim3=size(field(1)%rval4d,2)
	1008	dim4=size(field(1)%rval4d,3)
	1009	DO ireq=1,message%nreq
	1010	message%buffers(ireq)%size=message%buffers(ireq)%sizedim3dim4
	1011	CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
	1012	ENDDO
	1013	ENDIF
	1014	ENDIF
[151]	1015
[186]	1016
[151]	1017
[186]	1018	! ! Reorder the request, so recv request are done in the same order than send request
	1019
	1020	! nreq_send=sum(request(:)%nsend)
	1021	! message%nreq_send=nreq_send
	1022	! ALLOCATE(message%reorder(nreq_send))
	1023	! reorder=>message%reorder
	1024	! ireq=0
	1025	! DO ind=1,ndomain
	1026	! req=>request(ind)
	1027	! DO isend=1,req%nsend
	1028	! ireq=ireq+1
	1029	! reorder(ireq)%ind=ind
	1030	! reorder(ireq)%isend=isend
	1031	! reorder(ireq)%tag=req%send(isend)%tag
	1032	! ENDDO
	1033	! ENDDO
	1034
	1035	! ! do a very very bad sort
	1036	! DO i=1,nreq_send-1
	1037	! DO j=i+1,nreq_send
	1038	! IF (reorder(i)%tag > reorder(j)%tag) THEN
	1039	! reorder_swap=reorder(i)
	1040	! reorder(i)=reorder(j)
	1041	! reorder(j)=reorder_swap
	1042	! ENDIF
	1043	! ENDDO
	1044	! ENDDO
	1045	! PRINT *,"reorder ",reorder(:)%tag
	1046
[151]	1047
[186]	1048	!$OMP END MASTER
	1049	!$OMP BARRIER
[151]	1050
[186]	1051	END SUBROUTINE init_message_mpi
	1052
	1053	SUBROUTINE Finalize_message_mpi(field,message)
	1054	USE field_mod
	1055	USE domain_mod
	1056	USE mpi_mod
	1057	USE mpipara
	1058	USE mpi_mod
	1059	IMPLICIT NONE
	1060	TYPE(t_field),POINTER :: field(:)
	1061	TYPE(t_message) :: message
	1062
	1063	TYPE(t_request),POINTER :: req
	1064	INTEGER :: irecv,isend
	1065	INTEGER :: ireq,nreq
	1066	INTEGER :: ind
	1067
	1068	!$OMP BARRIER
	1069	!$OMP MASTER
	1070
	1071
	1072	IF (field(1)%data_type==type_real) THEN
	1073
	1074	IF (field(1)%ndim==2) THEN
	1075
	1076	DO ireq=1,message%nreq
	1077	CALL free_mpi_buffer(message%buffers(ireq)%r)
[151]	1078	ENDDO
[186]	1079
	1080	ELSE IF (field(1)%ndim==3) THEN
[151]	1081
[186]	1082	DO ireq=1,message%nreq
	1083	CALL free_mpi_buffer(message%buffers(ireq)%r)
	1084	ENDDO
	1085
[151]	1086	ELSE IF (field(1)%ndim==4) THEN
	1087
[186]	1088	DO ireq=1,message%nreq
	1089	CALL free_mpi_buffer(message%buffers(ireq)%r)
[151]	1090	ENDDO
[186]	1091
[151]	1092	ENDIF
	1093	ENDIF
[186]	1094
[364]	1095	DEALLOCATE(message%mpi_req)
	1096	DEALLOCATE(message%buffers)
	1097	DEALLOCATE(message%status)
[186]	1098
[151]	1099	!$OMP END MASTER
[186]	1100	!$OMP BARRIER
	1101
	1102
	1103	END SUBROUTINE Finalize_message_mpi
	1104
	1105
[151]	1106
	1107	SUBROUTINE barrier
	1108	USE mpi_mod
	1109	USE mpipara
	1110	IMPLICIT NONE
	1111
	1112	CALL MPI_BARRIER(comm_icosa,ierr)
	1113
	1114	END SUBROUTINE barrier
	1115
	1116	SUBROUTINE transfert_message_mpi(field,message)
	1117	USE field_mod
	1118	IMPLICIT NONE
	1119	TYPE(t_field),POINTER :: field(:)
	1120	TYPE(t_message) :: message
	1121
	1122	CALL send_message_mpi(field,message)
	1123	CALL wait_message_mpi(message)
	1124
	1125	END SUBROUTINE transfert_message_mpi
	1126
	1127
	1128	SUBROUTINE send_message_mpi(field,message)
[714]	1129	USE profiling_mod
[151]	1130	USE field_mod
	1131	USE domain_mod
	1132	USE mpi_mod
	1133	USE mpipara
	1134	USE omp_para
	1135	USE trace
	1136	IMPLICIT NONE
	1137	TYPE(t_field),POINTER :: field(:)
	1138	TYPE(t_message) :: message
[176]	1139	REAL(rstd),POINTER :: rval2d(:), src_rval2d(:)
	1140	REAL(rstd),POINTER :: rval3d(:,:), src_rval3d(:,:)
	1141	REAL(rstd),POINTER :: rval4d(:,:,:), src_rval4d(:,:,:)
[186]	1142	REAL(rstd),POINTER :: buffer_r(:)
[151]	1143	INTEGER,POINTER :: value(:)
	1144	INTEGER,POINTER :: sgn(:)
	1145	TYPE(ARRAY),POINTER :: recv,send
	1146	TYPE(t_request),POINTER :: req
	1147	INTEGER, ALLOCATABLE :: mpi_req(:)
	1148	INTEGER, ALLOCATABLE :: status(:,:)
	1149	INTEGER :: irecv,isend
[186]	1150	INTEGER :: ireq,nreq
	1151	INTEGER :: ind,i,n,l,m
	1152	INTEGER :: dim3,dim4,d3,d4
[176]	1153	INTEGER,POINTER :: src_value(:)
	1154	INTEGER,POINTER :: sign(:)
[186]	1155	INTEGER :: offset,msize,rank
[327]	1156	INTEGER :: lbegin, lend
[478]	1157	INTEGER :: max_req
[151]	1158
[327]	1159	! CALL trace_start("send_message_mpi")
[186]	1160
[714]	1161	CALL enter_profile(id_mpi)
	1162
[151]	1163	!$OMP BARRIER
	1164
	1165
[186]	1166	!$OMP MASTER
[364]	1167	IF(message%open) THEN
	1168	PRINT *, 'send_message_mpi : message ' // TRIM(message%name) // &
	1169	' is still open, no call to wait_message_mpi after last send_message_mpi'
	1170	CALL ABORT
	1171	END IF
	1172	message%open=.TRUE. ! will be set to .FALSE. by wait_message_mpi
	1173
[151]	1174	message%field=>field
	1175
[176]	1176	IF (message%nreq>0) THEN
	1177	message%completed=.FALSE.
	1178	message%pending=.TRUE.
	1179	ELSE
	1180	message%completed=.TRUE.
	1181	message%pending=.FALSE.
	1182	ENDIF
[151]	1183	!$OMP END MASTER
[186]	1184	!$OMP BARRIER
	1185
[151]	1186	IF (field(1)%data_type==type_real) THEN
	1187	IF (field(1)%ndim==2) THEN
	1188
	1189	DO ind=1,ndomain
[295]	1190	IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
[186]	1191
[151]	1192	rval2d=>field(ind)%rval2d
	1193
	1194	req=>message%request(ind)
	1195	DO isend=1,req%nsend
	1196	send=>req%send(isend)
	1197	value=>send%value
	1198
[176]	1199
[186]	1200	IF (send%rank/=mpi_rank) THEN
	1201	ireq=send%ireq
[151]	1202
[186]	1203	buffer_r=>message%buffers(ireq)%r
	1204	offset=send%offset
	1205
[176]	1206	DO n=1,send%size
[186]	1207	buffer_r(offset+n)=rval2d(value(n))
[176]	1208	ENDDO
[151]	1209
[186]	1210	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
	1211	!$OMP CRITICAL
[358]	1212	CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank, &
	1213	send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[186]	1214	!$OMP END CRITICAL
	1215	ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
[358]	1216	CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank, &
	1217	send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[186]	1218	ENDIF
[176]	1219
[186]	1220	ENDIF
[151]	1221	ENDDO
[186]	1222	ENDDO
[151]	1223
[186]	1224	DO ind=1,ndomain
[295]	1225	IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
[186]	1226	rval2d=>field(ind)%rval2d
	1227	req=>message%request(ind)
	1228
[151]	1229	DO irecv=1,req%nrecv
	1230	recv=>req%recv(irecv)
[176]	1231
[186]	1232	IF (recv%rank==mpi_rank) THEN
	1233
[176]	1234	value=>recv%value
	1235	src_value => recv%src_value
	1236	src_rval2d=>field(recv%domain)%rval2d
	1237	sgn=>recv%sign
[186]	1238
[176]	1239	DO n=1,recv%size
	1240	rval2d(value(n))=src_rval2d(src_value(n))*sgn(n)
	1241	ENDDO
[186]	1242
	1243
	1244	ELSE
[176]	1245
[186]	1246	ireq=recv%ireq
	1247	buffer_r=>message%buffers(ireq)%r
	1248	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
	1249	!$OMP CRITICAL
[358]	1250	CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank, &
	1251	recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[186]	1252	!$OMP END CRITICAL
	1253	ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
[358]	1254	CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank, &
	1255	recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[186]	1256	ENDIF
	1257
[176]	1258	ENDIF
[151]	1259	ENDDO
	1260
	1261	ENDDO
[186]	1262
[151]	1263
	1264	ELSE IF (field(1)%ndim==3) THEN
[478]	1265	max_req=0
[151]	1266	DO ind=1,ndomain
[478]	1267	req=>message%request(ind)
	1268	IF (req%nsend>max_req) max_req=req%nsend
	1269	ENDDO
	1270
	1271	DO ind=1,ndomain
[327]	1272	IF (.NOT. assigned_domain(ind) ) CYCLE
[186]	1273
[151]	1274	dim3=size(field(ind)%rval3d,2)
[603]	1275	CALL distrib_level(1,dim3, lbegin,lend)
[327]	1276
[151]	1277	rval3d=>field(ind)%rval3d
	1278	req=>message%request(ind)
	1279
	1280	DO isend=1,req%nsend
	1281	send=>req%send(isend)
	1282	value=>send%value
	1283
[186]	1284	IF (send%rank/=mpi_rank) THEN
	1285	ireq=send%ireq
	1286	buffer_r=>message%buffers(ireq)%r
	1287
[327]	1288	offset=send%offsetdim3 + (lbegin-1)send%size
	1289
	1290	CALL trace_start("copy_to_buffer")
	1291
	1292	DO d3=lbegin,lend
[176]	1293	DO n=1,send%size
[186]	1294	buffer_r(n+offset)=rval3d(value(n),d3)
[176]	1295	ENDDO
[186]	1296	offset=offset+send%size
	1297	ENDDO
[327]	1298	CALL trace_end("copy_to_buffer")
[151]	1299
[478]	1300	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
	1301	!$OMP BARRIER
	1302	ENDIF
	1303
[327]	1304	IF (is_omp_level_master) THEN
	1305	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
	1306	!$OMP CRITICAL
[358]	1307	CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank, &
	1308	send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[327]	1309	!$OMP END CRITICAL
	1310	ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
[358]	1311	CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank, &
	1312	send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[327]	1313	ENDIF
[186]	1314	ENDIF
[478]	1315	ELSE
	1316	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
	1317	!$OMP BARRIER
	1318	ENDIF
[186]	1319	ENDIF
	1320	ENDDO
[478]	1321
	1322	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
	1323	DO isend=req%nsend+1,max_req
	1324	!$OMP BARRIER
	1325	ENDDO
	1326	ENDIF
	1327
[186]	1328	ENDDO
	1329
	1330	DO ind=1,ndomain
[327]	1331	IF (.NOT. assigned_domain(ind) ) CYCLE
[186]	1332	dim3=size(field(ind)%rval3d,2)
[603]	1333	CALL distrib_level(1,dim3, lbegin,lend)
[186]	1334	rval3d=>field(ind)%rval3d
	1335	req=>message%request(ind)
[151]	1336
	1337	DO irecv=1,req%nrecv
	1338	recv=>req%recv(irecv)
[176]	1339
[186]	1340	IF (recv%rank==mpi_rank) THEN
[176]	1341	value=>recv%value
	1342	src_value => recv%src_value
	1343	src_rval3d=>field(recv%domain)%rval3d
	1344	sgn=>recv%sign
[186]	1345
[327]	1346	CALL trace_start("copy_data")
	1347
	1348	DO d3=lbegin,lend
	1349	DO n=1,recv%size
	1350	rval3d(value(n),d3)=src_rval3d(src_value(n),d3)*sgn(n)
	1351	ENDDO
[176]	1352	ENDDO
[327]	1353	CALL trace_end("copy_data")
[186]	1354
[176]	1355	ELSE
[186]	1356	ireq=recv%ireq
	1357	buffer_r=>message%buffers(ireq)%r
	1358
[327]	1359	IF (is_omp_level_master) THEN
	1360	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
	1361	!$OMP CRITICAL
[358]	1362	CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank, &
	1363	recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[327]	1364	!$OMP END CRITICAL
	1365	ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
[358]	1366	CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank, &
	1367	recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[327]	1368	ENDIF
[186]	1369	ENDIF
[327]	1370	ENDIF
[151]	1371	ENDDO
	1372
	1373	ENDDO
	1374
	1375	ELSE IF (field(1)%ndim==4) THEN
[478]	1376
	1377	max_req=0
	1378	DO ind=1,ndomain
	1379	req=>message%request(ind)
	1380	IF (req%nsend>max_req) max_req=req%nsend
	1381	ENDDO
[151]	1382
	1383	DO ind=1,ndomain
[327]	1384	IF (.NOT. assigned_domain(ind) ) CYCLE
[186]	1385
[151]	1386	dim3=size(field(ind)%rval4d,2)
[603]	1387	CALL distrib_level(1,dim3, lbegin,lend)
[151]	1388	dim4=size(field(ind)%rval4d,3)
	1389	rval4d=>field(ind)%rval4d
	1390	req=>message%request(ind)
	1391
	1392	DO isend=1,req%nsend
	1393	send=>req%send(isend)
	1394	value=>send%value
	1395
[186]	1396	IF (send%rank/=mpi_rank) THEN
[151]	1397
[186]	1398	ireq=send%ireq
	1399	buffer_r=>message%buffers(ireq)%r
	1400
[327]	1401	CALL trace_start("copy_to_buffer")
[186]	1402	DO d4=1,dim4
[358]	1403	offset=send%offsetdim3dim4 + dim3send%size(d4-1) + &
	1404	(lbegin-1)*send%size
[327]	1405
	1406	DO d3=lbegin,lend
[186]	1407	DO n=1,send%size
	1408	buffer_r(n+offset)=rval4d(value(n),d3,d4)
	1409	ENDDO
	1410	offset=offset+send%size
	1411	ENDDO
[176]	1412	ENDDO
[327]	1413	CALL trace_end("copy_to_buffer")
[151]	1414
[478]	1415	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
	1416	!$OMP BARRIER
	1417	ENDIF
	1418
[327]	1419	IF (is_omp_level_master) THEN
	1420	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
	1421	!$OMP CRITICAL
[358]	1422	CALL MPI_ISEND(buffer_r,send%sizedim3dim4,MPI_REAL8,send%rank, &
	1423	send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[327]	1424	!$OMP END CRITICAL
	1425	ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
[358]	1426	CALL MPI_ISEND(buffer_r,send%sizedim3dim4,MPI_REAL8,send%rank, &
	1427	send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[327]	1428	ENDIF
[186]	1429	ENDIF
[478]	1430	ELSE
	1431	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
	1432	!$OMP BARRIER
	1433	ENDIF
[176]	1434	ENDIF
[151]	1435	ENDDO
[478]	1436
	1437	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
	1438	DO isend=req%nsend+1,max_req
	1439	!$OMP BARRIER
	1440	ENDDO
	1441	ENDIF
	1442
[186]	1443	ENDDO
[151]	1444
[186]	1445	DO ind=1,ndomain
[327]	1446	IF (.NOT. assigned_domain(ind) ) CYCLE
[186]	1447
	1448	dim3=size(field(ind)%rval4d,2)
[603]	1449	CALL distrib_level(1,dim3, lbegin,lend)
[186]	1450	dim4=size(field(ind)%rval4d,3)
	1451	rval4d=>field(ind)%rval4d
	1452	req=>message%request(ind)
	1453
[151]	1454	DO irecv=1,req%nrecv
	1455	recv=>req%recv(irecv)
[186]	1456	IF (recv%rank==mpi_rank) THEN
[176]	1457	value=>recv%value
	1458	src_value => recv%src_value
	1459	src_rval4d=>field(recv%domain)%rval4d
	1460	sgn=>recv%sign
	1461
[327]	1462	CALL trace_start("copy_data")
	1463	DO d4=1,dim4
	1464	DO d3=lbegin,lend
	1465	DO n=1,recv%size
	1466	rval4d(value(n),d3,d4)=src_rval4d(src_value(n),d3,d4)*sgn(n)
	1467	ENDDO
	1468	ENDDO
[176]	1469	ENDDO
[327]	1470
	1471	CALL trace_end("copy_data")
[186]	1472
[176]	1473	ELSE
[186]	1474
	1475	ireq=recv%ireq
	1476	buffer_r=>message%buffers(ireq)%r
[327]	1477	IF (is_omp_level_master) THEN
	1478	IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
	1479	!$OMP CRITICAL
[358]	1480	CALL MPI_IRECV(buffer_r,recv%sizedim3dim4,MPI_REAL8,recv%rank, &
	1481	recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[327]	1482	!$OMP END CRITICAL
	1483	ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
[358]	1484	CALL MPI_IRECV(buffer_r,recv%sizedim3dim4,MPI_REAL8,recv%rank, &
	1485	recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
[327]	1486	ENDIF
[186]	1487	ENDIF
[176]	1488	ENDIF
[151]	1489	ENDDO
	1490	ENDDO
[186]	1491
[151]	1492	ENDIF
[186]	1493
[193]	1494	IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
[186]	1495	!$OMP BARRIER
	1496	!$OMP MASTER
	1497
	1498	DO ireq=1,message%nreq_send
	1499	buffer_r=>message%buffers(ireq)%r
	1500	msize=message%buffers(ireq)%size
	1501	rank=message%buffers(ireq)%rank
[358]	1502	CALL MPI_ISEND(buffer_r,msize,MPI_REAL8,rank,1000*message%number, &
	1503	comm_icosa, message%mpi_req(ireq),ierr)
[186]	1504	ENDDO
	1505
	1506	DO ireq=message%nreq_send+1,message%nreq_send+message%nreq_recv
	1507	buffer_r=>message%buffers(ireq)%r
	1508	msize=message%buffers(ireq)%size
	1509	rank=message%buffers(ireq)%rank
[358]	1510	CALL MPI_IRECV(buffer_r,msize,MPI_REAL8,rank,1000*message%number, &
	1511	comm_icosa, message%mpi_req(ireq),ierr)
[186]	1512	ENDDO
	1513
	1514	!$OMP END MASTER
	1515	ENDIF
[151]	1516	ENDIF
[176]	1517
[186]	1518	!$OMP BARRIER
[327]	1519	! CALL trace_end("send_message_mpi")
[714]	1520
	1521	CALL exit_profile(id_mpi)
[151]	1522
	1523	END SUBROUTINE send_message_mpi
	1524
	1525	SUBROUTINE test_message_mpi(message)
	1526	IMPLICIT NONE
	1527	TYPE(t_message) :: message
	1528
	1529	INTEGER :: ierr
	1530
	1531	!$OMP MASTER
[358]	1532	IF (message%pending .AND. .NOT. message%completed) CALL MPI_TESTALL(message%nreq,&
	1533	message%mpi_req,message%completed,message%status,ierr)
[151]	1534	!$OMP END MASTER
	1535	END SUBROUTINE test_message_mpi
	1536
	1537
	1538	SUBROUTINE wait_message_mpi(message)
[714]	1539	USE profiling_mod
[151]	1540	USE field_mod
	1541	USE domain_mod
	1542	USE mpi_mod
	1543	USE mpipara
	1544	USE omp_para
	1545	USE trace
	1546	IMPLICIT NONE
	1547	TYPE(t_message) :: message
	1548
	1549	TYPE(t_field),POINTER :: field(:)
	1550	REAL(rstd),POINTER :: rval2d(:)
	1551	REAL(rstd),POINTER :: rval3d(:,:)
	1552	REAL(rstd),POINTER :: rval4d(:,:,:)
[186]	1553	REAL(rstd),POINTER :: buffer_r(:)
[151]	1554	INTEGER,POINTER :: value(:)
	1555	INTEGER,POINTER :: sgn(:)
	1556	TYPE(ARRAY),POINTER :: recv,send
	1557	TYPE(t_request),POINTER :: req
	1558	INTEGER, ALLOCATABLE :: mpi_req(:)
	1559	INTEGER, ALLOCATABLE :: status(:,:)
	1560	INTEGER :: irecv,isend
	1561	INTEGER :: ireq,nreq
[186]	1562	INTEGER :: ind,n,l,m,i
[327]	1563	INTEGER :: dim3,dim4,d3,d4,lbegin,lend
[186]	1564	INTEGER :: offset
[151]	1565
[364]	1566	message%open=.FALSE.
[186]	1567	IF (.NOT. message%pending) RETURN
[151]	1568
[714]	1569	CALL enter_profile(id_mpi)
	1570
[327]	1571	! CALL trace_start("wait_message_mpi")
[151]	1572
	1573	field=>message%field
	1574	nreq=message%nreq
	1575
	1576	IF (field(1)%data_type==type_real) THEN
	1577	IF (field(1)%ndim==2) THEN
	1578
	1579	!$OMP MASTER
[358]	1580	IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req, &
	1581	message%status,ierr)
[151]	1582	!$OMP END MASTER
	1583	!$OMP BARRIER
[186]	1584
[151]	1585	DO ind=1,ndomain
[295]	1586	IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
[186]	1587
[151]	1588	rval2d=>field(ind)%rval2d
	1589	req=>message%request(ind)
	1590	DO irecv=1,req%nrecv
	1591	recv=>req%recv(irecv)
[186]	1592	IF (recv%rank/=mpi_rank) THEN
	1593	ireq=recv%ireq
	1594	buffer_r=>message%buffers(ireq)%r
[176]	1595	value=>recv%value
	1596	sgn=>recv%sign
[186]	1597	offset=recv%offset
[176]	1598	DO n=1,recv%size
[186]	1599	rval2d(value(n))=buffer_r(n+offset)*sgn(n)
	1600	ENDDO
[151]	1601
[176]	1602	ENDIF
[151]	1603	ENDDO
	1604
	1605	ENDDO
	1606
	1607
	1608	ELSE IF (field(1)%ndim==3) THEN
	1609
	1610	!$OMP MASTER
[358]	1611	IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req, &
	1612	message%status,ierr)
[151]	1613	!$OMP END MASTER
	1614	!$OMP BARRIER
	1615
[186]	1616
[151]	1617	DO ind=1,ndomain
[327]	1618	IF (.NOT. assigned_domain(ind) ) CYCLE
[186]	1619
[151]	1620	rval3d=>field(ind)%rval3d
	1621	req=>message%request(ind)
	1622	DO irecv=1,req%nrecv
	1623	recv=>req%recv(irecv)
[186]	1624	IF (recv%rank/=mpi_rank) THEN
	1625	ireq=recv%ireq
	1626	buffer_r=>message%buffers(ireq)%r
[176]	1627	value=>recv%value
	1628	sgn=>recv%sign
[186]	1629
	1630	dim3=size(rval3d,2)
[327]	1631
[603]	1632	CALL distrib_level(1,dim3, lbegin,lend)
[327]	1633	offset=recv%offsetdim3 + (lbegin-1)recv%size
	1634	CALL trace_start("copy_from_buffer")
	1635
	1636	IF (req%vector) THEN
	1637	DO d3=lbegin,lend
	1638	DO n=1,recv%size
	1639	rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)
	1640	ENDDO
	1641	offset=offset+recv%size
[186]	1642	ENDDO
[327]	1643	ELSE
	1644	DO d3=lbegin,lend
	1645	DO n=1,recv%size
	1646	rval3d(value(n),d3)=buffer_r(n+offset)
	1647	ENDDO
	1648	offset=offset+recv%size
	1649	ENDDO
	1650	ENDIF
	1651
	1652	CALL trace_end("copy_from_buffer")
[176]	1653	ENDIF
[151]	1654	ENDDO
	1655
	1656	ENDDO
	1657
	1658	ELSE IF (field(1)%ndim==4) THEN
	1659	!$OMP MASTER
[358]	1660	IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req, &
	1661	message%status,ierr)
[151]	1662	!$OMP END MASTER
	1663	!$OMP BARRIER
	1664
[186]	1665
[151]	1666	DO ind=1,ndomain
[327]	1667	IF (.NOT. assigned_domain(ind) ) CYCLE
[186]	1668
[151]	1669	rval4d=>field(ind)%rval4d
	1670	req=>message%request(ind)
	1671	DO irecv=1,req%nrecv
	1672	recv=>req%recv(irecv)
[186]	1673	IF (recv%rank/=mpi_rank) THEN
	1674	ireq=recv%ireq
	1675	buffer_r=>message%buffers(ireq)%r
[176]	1676	value=>recv%value
	1677	sgn=>recv%sign
[151]	1678
[186]	1679	dim3=size(rval4d,2)
[603]	1680	CALL distrib_level(1,dim3, lbegin,lend)
[186]	1681	dim4=size(rval4d,3)
[327]	1682	CALL trace_start("copy_from_buffer")
[186]	1683	DO d4=1,dim4
[358]	1684	offset=recv%offsetdim3dim4 + dim3recv%size(d4-1) + &
	1685	(lbegin-1)*recv%size
[327]	1686	DO d3=lbegin,lend
[186]	1687	DO n=1,recv%size
	1688	rval4d(value(n),d3,d4)=buffer_r(n+offset)*sgn(n)
	1689	ENDDO
	1690	offset=offset+recv%size
	1691	ENDDO
[176]	1692	ENDDO
[327]	1693	CALL trace_end("copy_from_buffer")
[176]	1694	ENDIF
[151]	1695	ENDDO
	1696
	1697	ENDDO
	1698
	1699	ENDIF
	1700
	1701	ENDIF
	1702
	1703	!$OMP MASTER
	1704	message%pending=.FALSE.
	1705	!$OMP END MASTER
	1706
[327]	1707	! CALL trace_end("wait_message_mpi")
[151]	1708	!$OMP BARRIER
	1709
[714]	1710	CALL exit_profile(id_mpi)
	1711
[151]	1712	END SUBROUTINE wait_message_mpi
	1713
[26]	1714	SUBROUTINE transfert_request_mpi(field,request)
	1715	USE field_mod
	1716	IMPLICIT NONE
	1717	TYPE(t_field),POINTER :: field(:)
	1718	TYPE(t_request),POINTER :: request(:)
	1719
[186]	1720	TYPE(t_message),SAVE :: message
	1721
	1722
	1723	CALL init_message_mpi(field,request, message)
	1724	CALL transfert_message_mpi(field,message)
	1725	CALL finalize_message_mpi(field,message)
	1726
[26]	1727	END SUBROUTINE transfert_request_mpi
[186]	1728
[26]	1729
[186]	1730
[151]	1731	SUBROUTINE transfert_request_seq(field,request)
[26]	1732	USE field_mod
	1733	USE domain_mod
	1734	IMPLICIT NONE
	1735	TYPE(t_field),POINTER :: field(:)
	1736	TYPE(t_request),POINTER :: request(:)
	1737	REAL(rstd),POINTER :: rval2d(:)
	1738	REAL(rstd),POINTER :: rval3d(:,:)
	1739	REAL(rstd),POINTER :: rval4d(:,:,:)
	1740	INTEGER :: ind
	1741	TYPE(t_request),POINTER :: req
	1742	INTEGER :: n
	1743	REAL(rstd) :: var1,var2
	1744
	1745	DO ind=1,ndomain
	1746	req=>request(ind)
	1747	rval2d=>field(ind)%rval2d
	1748	rval3d=>field(ind)%rval3d
	1749	rval4d=>field(ind)%rval4d
	1750
	1751	IF (field(ind)%data_type==type_real) THEN
	1752	IF (field(ind)%ndim==2) THEN
	1753	DO n=1,req%size
[358]	1754	rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n))*&
	1755	req%target_sign(n)
[26]	1756	ENDDO
	1757	ELSE IF (field(ind)%ndim==3) THEN
	1758	DO n=1,req%size
[358]	1759	rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:)*&
	1760	req%target_sign(n)
[26]	1761	ENDDO
	1762	ELSE IF (field(ind)%ndim==4) THEN
	1763	DO n=1,req%size
[358]	1764	rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:)*&
	1765	req%target_sign(n)
[26]	1766	ENDDO
	1767	ENDIF
	1768	ENDIF
	1769
	1770	ENDDO
	1771
[151]	1772	END SUBROUTINE transfert_request_seq
[26]	1773
	1774
	1775	SUBROUTINE gather_field(field_loc,field_glo)
	1776	USE field_mod
	1777	USE domain_mod
	1778	USE mpi_mod
	1779	USE mpipara
	1780	IMPLICIT NONE
	1781	TYPE(t_field),POINTER :: field_loc(:)
	1782	TYPE(t_field),POINTER :: field_glo(:)
	1783	INTEGER, ALLOCATABLE :: mpi_req(:)
	1784	INTEGER, ALLOCATABLE :: status(:,:)
	1785	INTEGER :: ireq,nreq
	1786	INTEGER :: ind_glo,ind_loc
	1787
	1788	IF (.NOT. using_mpi) THEN
	1789
	1790	DO ind_loc=1,ndomain
	1791	IF (field_loc(ind_loc)%ndim==2) field_glo(ind_loc)%rval2d=field_loc(ind_loc)%rval2d
	1792	IF (field_loc(ind_loc)%ndim==3) field_glo(ind_loc)%rval3d=field_loc(ind_loc)%rval3d
	1793	IF (field_loc(ind_loc)%ndim==4) field_glo(ind_loc)%rval4d=field_loc(ind_loc)%rval4d
	1794	ENDDO
	1795
	1796	ELSE
	1797
	1798	nreq=ndomain
	1799	IF (mpi_rank==0) nreq=nreq+ndomain_glo
	1800	ALLOCATE(mpi_req(nreq))
	1801	ALLOCATE(status(MPI_STATUS_SIZE,nreq))
	1802
	1803
	1804	ireq=0
	1805	IF (mpi_rank==0) THEN
	1806	DO ind_glo=1,ndomain_glo
	1807	ireq=ireq+1
	1808
	1809	IF (field_glo(ind_glo)%ndim==2) THEN
	1810	CALL MPI_IRECV(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 , &
	1811	domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
	1812
	1813	ELSE IF (field_glo(ind_glo)%ndim==3) THEN
	1814	CALL MPI_IRECV(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 , &
	1815	domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
	1816
	1817	ELSE IF (field_glo(ind_glo)%ndim==4) THEN
[31]	1818	CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 , &
[26]	1819	domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
	1820	ENDIF
	1821
	1822	ENDDO
	1823	ENDIF
	1824
	1825	DO ind_loc=1,ndomain
	1826	ireq=ireq+1
	1827
	1828	IF (field_loc(ind_loc)%ndim==2) THEN
	1829	CALL MPI_ISEND(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 , &
	1830	0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
	1831	ELSE IF (field_loc(ind_loc)%ndim==3) THEN
	1832	CALL MPI_ISEND(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 , &
	1833	0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
	1834	ELSE IF (field_loc(ind_loc)%ndim==4) THEN
	1835	CALL MPI_ISEND(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 , &
	1836	0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
	1837	ENDIF
	1838
	1839	ENDDO
	1840
	1841	CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
	1842
	1843	ENDIF
	1844
	1845	END SUBROUTINE gather_field
[151]	1846
[392]	1847	SUBROUTINE bcast_field(field_glo)
	1848	USE field_mod
	1849	USE domain_mod
	1850	USE mpi_mod
	1851	USE mpipara
	1852	IMPLICIT NONE
	1853	TYPE(t_field),POINTER :: field_glo(:)
	1854	INTEGER :: ind_glo
	1855
	1856	IF (.NOT. using_mpi) THEN
	1857
	1858	! nothing to do
	1859
	1860	ELSE
	1861
	1862	DO ind_glo=1,ndomain_glo
[266]	1863
[392]	1864	IF (field_glo(ind_glo)%ndim==2) THEN
	1865	CALL MPI_BCAST(field_glo(ind_glo)%rval2d, size(field_glo(ind_glo)%rval2d) , MPI_REAL8, 0, comm_icosa, ierr)
	1866	ELSE IF (field_glo(ind_glo)%ndim==3) THEN
	1867	CALL MPI_BCAST(field_glo(ind_glo)%rval3d, size(field_glo(ind_glo)%rval3d) , MPI_REAL8, 0, comm_icosa, ierr)
	1868	ELSE IF (field_glo(ind_glo)%ndim==4) THEN
	1869	CALL MPI_BCAST(field_glo(ind_glo)%rval4d, size(field_glo(ind_glo)%rval4d) , MPI_REAL8, 0, comm_icosa, ierr)
	1870	ENDIF
	1871
	1872	ENDDO
	1873	ENDIF
	1874
	1875	END SUBROUTINE bcast_field
	1876
[266]	1877	SUBROUTINE scatter_field(field_glo,field_loc)
	1878	USE field_mod
	1879	USE domain_mod
	1880	USE mpi_mod
	1881	USE mpipara
	1882	IMPLICIT NONE
	1883	TYPE(t_field),POINTER :: field_glo(:)
	1884	TYPE(t_field),POINTER :: field_loc(:)
	1885	INTEGER, ALLOCATABLE :: mpi_req(:)
	1886	INTEGER, ALLOCATABLE :: status(:,:)
	1887	INTEGER :: ireq,nreq
	1888	INTEGER :: ind_glo,ind_loc
	1889
	1890	IF (.NOT. using_mpi) THEN
	1891
	1892	DO ind_loc=1,ndomain
	1893	IF (field_loc(ind_loc)%ndim==2) field_loc(ind_loc)%rval2d=field_glo(ind_loc)%rval2d
	1894	IF (field_loc(ind_loc)%ndim==3) field_loc(ind_loc)%rval3d=field_glo(ind_loc)%rval3d
	1895	IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d
	1896	ENDDO
	1897
	1898	ELSE
	1899
	1900	nreq=ndomain
	1901	IF (mpi_rank==0) nreq=nreq+ndomain_glo
	1902	ALLOCATE(mpi_req(nreq))
	1903	ALLOCATE(status(MPI_STATUS_SIZE,nreq))
	1904
	1905
	1906	ireq=0
	1907	IF (mpi_rank==0) THEN
	1908	DO ind_glo=1,ndomain_glo
	1909	ireq=ireq+1
	1910
	1911	IF (field_glo(ind_glo)%ndim==2) THEN
	1912	CALL MPI_ISEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 , &
	1913	domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
[151]	1914
[266]	1915	ELSE IF (field_glo(ind_glo)%ndim==3) THEN
	1916	CALL MPI_ISEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 , &
	1917	domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
	1918
	1919	ELSE IF (field_glo(ind_glo)%ndim==4) THEN
	1920	CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 , &
	1921	domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
	1922	ENDIF
	1923
	1924	ENDDO
	1925	ENDIF
	1926
	1927	DO ind_loc=1,ndomain
	1928	ireq=ireq+1
	1929
	1930	IF (field_loc(ind_loc)%ndim==2) THEN
	1931	CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 , &
	1932	0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
	1933	ELSE IF (field_loc(ind_loc)%ndim==3) THEN
	1934	CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 , &
	1935	0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
	1936	ELSE IF (field_loc(ind_loc)%ndim==4) THEN
	1937	CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 , &
	1938	0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
	1939	ENDIF
	1940
	1941	ENDDO
	1942
	1943	CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
	1944
	1945	ENDIF
	1946
	1947	END SUBROUTINE scatter_field
[327]	1948
[151]	1949	SUBROUTINE trace_in
	1950	USE trace
	1951	IMPLICIT NONE
[26]	1952
[151]	1953	CALL trace_start("transfert_buffer")
	1954	END SUBROUTINE trace_in
[26]	1955
[151]	1956	SUBROUTINE trace_out
	1957	USE trace
	1958	IMPLICIT NONE
	1959
	1960	CALL trace_end("transfert_buffer")
	1961	END SUBROUTINE trace_out
	1962
[266]	1963
	1964
	1965
	1966	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1967	!! Definition des Broadcast --> 4D !!
	1968	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1969
[327]	1970	!! -- Les chaine de charactï¿œre -- !!
[266]	1971
	1972	SUBROUTINE bcast_mpi_c(var1)
	1973	IMPLICIT NONE
	1974	CHARACTER(LEN=*),INTENT(INOUT) :: Var1
	1975
	1976	CALL bcast_mpi_cgen(Var1,len(Var1))
	1977
	1978	END SUBROUTINE bcast_mpi_c
	1979
	1980	!! -- Les entiers -- !!
	1981
	1982	SUBROUTINE bcast_mpi_i(var)
	1983	USE mpipara
	1984	IMPLICIT NONE
	1985	INTEGER,INTENT(INOUT) :: Var
	1986
	1987	INTEGER :: var_tmp(1)
	1988
	1989	IF (is_mpi_master) var_tmp(1)=var
	1990	CALL bcast_mpi_igen(Var_tmp,1)
	1991	var=var_tmp(1)
	1992
	1993	END SUBROUTINE bcast_mpi_i
	1994
	1995	SUBROUTINE bcast_mpi_i1(var)
	1996	IMPLICIT NONE
	1997	INTEGER,INTENT(INOUT) :: Var(:)
	1998
	1999	CALL bcast_mpi_igen(Var,size(Var))
	2000
	2001	END SUBROUTINE bcast_mpi_i1
	2002
	2003	SUBROUTINE bcast_mpi_i2(var)
	2004	IMPLICIT NONE
	2005	INTEGER,INTENT(INOUT) :: Var(:,:)
	2006
	2007	CALL bcast_mpi_igen(Var,size(Var))
	2008
	2009	END SUBROUTINE bcast_mpi_i2
	2010
	2011	SUBROUTINE bcast_mpi_i3(var)
	2012	IMPLICIT NONE
	2013	INTEGER,INTENT(INOUT) :: Var(:,:,:)
	2014
	2015	CALL bcast_mpi_igen(Var,size(Var))
	2016
	2017	END SUBROUTINE bcast_mpi_i3
	2018
	2019	SUBROUTINE bcast_mpi_i4(var)
	2020	IMPLICIT NONE
	2021	INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
	2022
	2023	CALL bcast_mpi_igen(Var,size(Var))
	2024
	2025	END SUBROUTINE bcast_mpi_i4
	2026
	2027
	2028	!! -- Les reels -- !!
	2029
	2030	SUBROUTINE bcast_mpi_r(var)
	2031	USE mpipara
	2032	IMPLICIT NONE
	2033	REAL,INTENT(INOUT) :: Var
	2034	REAL :: var_tmp(1)
	2035
	2036	IF (is_mpi_master) var_tmp(1)=var
	2037	CALL bcast_mpi_rgen(Var_tmp,1)
	2038	var=var_tmp(1)
	2039
	2040	END SUBROUTINE bcast_mpi_r
	2041
	2042	SUBROUTINE bcast_mpi_r1(var)
	2043	IMPLICIT NONE
	2044	REAL,INTENT(INOUT) :: Var(:)
	2045
	2046	CALL bcast_mpi_rgen(Var,size(Var))
	2047
	2048	END SUBROUTINE bcast_mpi_r1
	2049
	2050	SUBROUTINE bcast_mpi_r2(var)
	2051	IMPLICIT NONE
	2052	REAL,INTENT(INOUT) :: Var(:,:)
	2053
	2054	CALL bcast_mpi_rgen(Var,size(Var))
	2055
	2056	END SUBROUTINE bcast_mpi_r2
	2057
	2058	SUBROUTINE bcast_mpi_r3(var)
	2059	IMPLICIT NONE
	2060	REAL,INTENT(INOUT) :: Var(:,:,:)
	2061
	2062	CALL bcast_mpi_rgen(Var,size(Var))
	2063
	2064	END SUBROUTINE bcast_mpi_r3
	2065
	2066	SUBROUTINE bcast_mpi_r4(var)
	2067	IMPLICIT NONE
	2068	REAL,INTENT(INOUT) :: Var(:,:,:,:)
	2069
	2070	CALL bcast_mpi_rgen(Var,size(Var))
	2071
	2072	END SUBROUTINE bcast_mpi_r4
	2073
	2074	!! -- Les booleans -- !!
	2075
	2076	SUBROUTINE bcast_mpi_l(var)
	2077	USE mpipara
	2078	IMPLICIT NONE
	2079	LOGICAL,INTENT(INOUT) :: Var
	2080	LOGICAL :: var_tmp(1)
	2081
	2082	IF (is_mpi_master) var_tmp(1)=var
	2083	CALL bcast_mpi_lgen(Var_tmp,1)
	2084	var=var_tmp(1)
	2085
	2086	END SUBROUTINE bcast_mpi_l
	2087
	2088	SUBROUTINE bcast_mpi_l1(var)
	2089	IMPLICIT NONE
	2090	LOGICAL,INTENT(INOUT) :: Var(:)
	2091
	2092	CALL bcast_mpi_lgen(Var,size(Var))
	2093
	2094	END SUBROUTINE bcast_mpi_l1
	2095
	2096	SUBROUTINE bcast_mpi_l2(var)
	2097	IMPLICIT NONE
	2098	LOGICAL,INTENT(INOUT) :: Var(:,:)
	2099
	2100	CALL bcast_mpi_lgen(Var,size(Var))
	2101
	2102	END SUBROUTINE bcast_mpi_l2
	2103
	2104	SUBROUTINE bcast_mpi_l3(var)
	2105	IMPLICIT NONE
	2106	LOGICAL,INTENT(INOUT) :: Var(:,:,:)
	2107
	2108	CALL bcast_mpi_lgen(Var,size(Var))
	2109
	2110	END SUBROUTINE bcast_mpi_l3
	2111
	2112	SUBROUTINE bcast_mpi_l4(var)
	2113	IMPLICIT NONE
	2114	LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
	2115
	2116	CALL bcast_mpi_lgen(Var,size(Var))
	2117
	2118	END SUBROUTINE bcast_mpi_l4
	2119
	2120	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	2121	!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
	2122	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	2123
	2124	SUBROUTINE bcast_mpi_cgen(var,nb)
	2125	USE mpi_mod
	2126	USE mpipara
	2127	IMPLICIT NONE
	2128
	2129	CHARACTER(LEN=*),INTENT(INOUT) :: Var
	2130	INTEGER,INTENT(IN) :: nb
	2131
	2132	IF (.NOT. using_mpi) RETURN
	2133
	2134	CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,comm_icosa,ierr)
	2135
	2136	END SUBROUTINE bcast_mpi_cgen
	2137
	2138
	2139
	2140	SUBROUTINE bcast_mpi_igen(var,nb)
	2141	USE mpi_mod
	2142	USE mpipara
	2143	IMPLICIT NONE
	2144
	2145	INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
	2146	INTEGER,INTENT(IN) :: nb
	2147
	2148	IF (.NOT. using_mpi) RETURN
	2149
	2150	CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,comm_icosa,ierr)
	2151
	2152	END SUBROUTINE bcast_mpi_igen
	2153
	2154
	2155
	2156
	2157	SUBROUTINE bcast_mpi_rgen(var,nb)
	2158	USE mpi_mod
	2159	USE mpipara
	2160	IMPLICIT NONE
	2161
	2162	REAL,DIMENSION(nb),INTENT(INOUT) :: Var
	2163	INTEGER,INTENT(IN) :: nb
	2164
	2165	IF (.NOT. using_mpi) RETURN
	2166
[327]	2167	CALL MPI_BCAST(Var,nb,MPI_REAL8,mpi_master,comm_icosa,ierr)
[266]	2168
	2169	END SUBROUTINE bcast_mpi_rgen
	2170
	2171
	2172
	2173
	2174	SUBROUTINE bcast_mpi_lgen(var,nb)
	2175	USE mpi_mod
	2176	USE mpipara
	2177	IMPLICIT NONE
	2178
	2179	LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
	2180	INTEGER,INTENT(IN) :: nb
	2181
	2182	IF (.NOT. using_mpi) RETURN
	2183
	2184	CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,comm_icosa,ierr)
	2185
	2186	END SUBROUTINE bcast_mpi_lgen
	2187
	2188
[26]	2189	END MODULE transfert_mpi_mod
	2190
	2191
	2192
	2193
	2194

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

Download in other formats: