diff --git a/Avancement.txt b/Avancement.txt index 30b49c57fb3e5ceefa75eed4d0da77e199abdcce..b930944e1a9f32c6d8cbf1439b54ba45c5140d58 100644 --- a/Avancement.txt +++ b/Avancement.txt @@ -1066,8 +1066,10 @@ mise à jour du code avec la dernière version d'André: parallélisation ouvrages c: -deux nouvelles routines: -ouvrages_c: initialise les vecteurs nécessaires à l'échange des mailles de contrôle - -message_group_calcul_c: envoie/réception des mailles de contrôle - + -message_group_calcul_c: envoie/réception des mailles de contrôle avec un mpi_alltoallv + +Dans message_group_calcul, remplacement des mpi_send et mpi_recv par un mpi_alltoallv +Idem dans message_group_calcul_logical => plus de problème de deadlock !!! diff --git a/module_messages.f90 b/module_messages.f90 index 2a186d658dcb3f65443ff15401293c8afc144d24..1f6ac3c610908c6452b552ab88f7d6eb6a7544c2 100644 --- a/module_messages.f90 +++ b/module_messages.f90 @@ -115,7 +115,7 @@ module module_messages ! échange de messages portant sur les mailles du bord !-------------------------------------------------------------------- use module_mpi,only:me,np,nb_elt_proc,elt_voisins,vecteur_message,& - &vecteur_reception,group_calcul,comm_calcul,deplacement_elt_proc,message,nploc + &vecteur_reception,group_calcul,comm_calcul,deplacement_elt_proc,message,message2,nploc use mpi implicit none @@ -128,87 +128,23 @@ module module_messages do i=1,size(vecteur_message) message(i)=vecteur(vecteur_message(i)) end do - do i=0,nploc-1 - if(nb_elt_proc(i)>0)then - call mpi_send(message(deplacement_elt_proc(i)+1:deplacement_elt_proc(i+1))& - &,nb_elt_proc(i),mpi_real8,i,3000+me,comm_calcul,statinfo) - call mpi_recv(message(deplacement_elt_proc(i)+1:deplacement_elt_proc(i+1))& - &,nb_elt_proc(i),mpi_real8,i,3000+i,comm_calcul,status,statinfo) - end if - end do -! do i=0,nploc-1 -! if(me==i)then -! do j=0,nploc-1 -! if(nb_elt_proc(j)>0)then -! call mpi_isend(message(deplacement_elt_proc(j)+1:deplacement_elt_proc(j+1))& -! &,nb_elt_proc(j),mpi_real8,j,3000+j,comm_calcul,req,statinfo) -! call MPI_Wait(req, status,statinfo) -! end if -! end do -! else -! if(nb_elt_proc(i)>0)call mpi_recv(message(deplacement_elt_proc(i)+1:deplacement_elt_proc(i+1))& -! &,nb_elt_proc(i),mpi_real8,i,3000+me,comm_calcul,status,statinfo) -! end if -! end do + call mpi_alltoallv(message,nb_elt_proc,deplacement_elt_proc,mpi_real8,& + &message2,nb_elt_proc,deplacement_elt_proc,mpi_real8,comm_calcul,statinfo) do i=1,size(vecteur_message) - vecteur(vecteur_reception(i))=message(i) + vecteur(vecteur_reception(i))=message2(i) end do end subroutine message_group_calcul - - subroutine message_group_calcul_tableau(tableau) -!-------------------------------------------------------------------- -! échange de messages portant sur les mailles du bord, dans le cas d'un tableau -!-------------------------------------------------------------------- - use module_mpi,only:me,np,nb_elt_proc,elt_voisins,vecteur_message,nploc,& - &vecteur_reception,group_calcul,comm_calcul,deplacement_elt_proc,message_tableau_aretes - use mpi - - implicit none - - real(wp),dimension(:,:),pointer,intent(inout)::tableau - integer::i,j - integer,dimension(mpi_status_size)::status - integer::statinfo - - do i=1,size(vecteur_message) - do j=1,4 - message_tableau_aretes(i,j)=tableau(vecteur_message(i),j) - end do - end do - - do i=0,nploc-1 - if(nb_elt_proc(i)>0)then - call mpi_send(message_tableau_aretes(deplacement_elt_proc(i)+1:deplacement_elt_proc(i+1),:)& - &,nb_elt_proc(i)*4,mpi_real8,i,3000+me,comm_calcul,statinfo) - end if - end do - - do i=0,nploc-1 - if(nb_elt_proc(i)>0)then - call mpi_recv(message_tableau_aretes(deplacement_elt_proc(i)+1:deplacement_elt_proc(i+1),:)& - &,nb_elt_proc(i)*4,mpi_real8,i,3000+i,comm_calcul,status,statinfo) - end if - end do - - do i=1,size(vecteur_message) - do j=1,4 - tableau(vecteur_reception(i),j)=message_tableau_aretes(i,j) - end do - end do - - end subroutine message_group_calcul_tableau - - + subroutine message_group_calcul_logical(vecteur) !-------------------------------------------------------------------- ! échange de messages portant sur les mailles du bord dans le cas d'un vecteur booléen !-------------------------------------------------------------------- use module_mpi,only:me,np,nb_elt_proc,elt_voisins,vecteur_message,nploc,& - &vecteur_reception,group_calcul,comm_calcul,deplacement_elt_proc,message_logical + &vecteur_reception,group_calcul,comm_calcul,deplacement_elt_proc,message_logical,message_logical2 use mpi implicit none @@ -221,23 +157,26 @@ module module_messages do i=1,size(vecteur_message) message_logical(i)=vecteur(vecteur_message(i)) end do +! +! do i=0,nploc-1 +! if(nb_elt_proc(i)>0)then +! call mpi_send(message_logical(deplacement_elt_proc(i)+1:deplacement_elt_proc(i+1))& +! &,nb_elt_proc(i),mpi_logical,i,3000+me,comm_calcul,statinfo) +! end if +! end do +! +! do i=0,nploc-1 +! if(nb_elt_proc(i)>0)then +! call mpi_recv(message_logical(deplacement_elt_proc(i)+1:deplacement_elt_proc(i+1))& +! &,nb_elt_proc(i),mpi_logical,i,3000+i,comm_calcul,status,statinfo) +! end if +! end do - do i=0,nploc-1 - if(nb_elt_proc(i)>0)then - call mpi_send(message_logical(deplacement_elt_proc(i)+1:deplacement_elt_proc(i+1))& - &,nb_elt_proc(i),mpi_logical,i,3000+me,comm_calcul,statinfo) - end if - end do - - do i=0,nploc-1 - if(nb_elt_proc(i)>0)then - call mpi_recv(message_logical(deplacement_elt_proc(i)+1:deplacement_elt_proc(i+1))& - &,nb_elt_proc(i),mpi_logical,i,3000+i,comm_calcul,status,statinfo) - end if - end do + call mpi_alltoallv(message_logical,nb_elt_proc,deplacement_elt_proc,mpi_logical,& + &message_logical2,nb_elt_proc,deplacement_elt_proc,mpi_logical,comm_calcul,statinfo) do i=1,size(vecteur_message) - vecteur(vecteur_reception(i))=message_logical(i) + vecteur(vecteur_reception(i))=message_logical2(i) end do end subroutine message_group_calcul_logical @@ -262,17 +201,10 @@ module module_messages do i=1,size(vecteur_message_c) message_c(i)=vecteur(vecteur_message_c(i)) end do - do i=0,nploc-1 - if(deplacement_message_c(i)/=deplacement_message_c(i+1))then - call mpi_send(message_c(deplacement_message_c(i)+1:deplacement_message_c(i+1))& - &,nb_elt_message_c(i),mpi_real8,i,2000+me,comm_calcul,statinfo) - end if - if(deplacement_reception_c(i)/=deplacement_reception_c(i+1))then - call mpi_recv(reception_c(deplacement_reception_c(i)+1:deplacement_reception_c(i+1))& - &,nb_elt_reception_c(i),mpi_real8,i,2000+i,comm_calcul,status,statinfo) - end if - end do + call mpi_alltoallv(message_c,nb_elt_message_c,deplacement_message_c,mpi_real8,& + &reception_c,nb_elt_reception_c,deplacement_reception_c,mpi_real8,comm_calcul,statinfo) + do i=1,size(vecteur_reception_c) vecteur(vecteur_reception_c(i))=reception_c(i) end do diff --git a/modules.f90 b/modules.f90 index 01f0271101d08cc0990dabb17e67df479efab206..31f7fa3f949e5a20bc6509346bc8841f713a5b8f 100644 --- a/modules.f90 +++ b/modules.f90 @@ -245,12 +245,12 @@ integer,dimension(:),pointer :: nb_ouvb_recus,deplacements3 integer,dimension(:),pointer::procouvb,machine integer,dimension(:),pointer::ne_loc - real(wp),dimension(:),pointer::message + real(wp),dimension(:),pointer::message,message2 real(wp),dimension(:),pointer::message_scribe,message_scribe2 logical,dimension(:),pointer::message_scribe3 integer,dimension(:),pointer::deplacement_elt_proc real(wp),dimension(:,:),pointer::message_tableau_aretes - logical,dimension(:),pointer::message_logical + logical,dimension(:),pointer::message_logical,message_logical2 integer::nploc integer,dimension(31:59)::machine_aretes30 integer,dimension(61:89)::machine_aretes60 diff --git a/modules_comptage.f90 b/modules_comptage.f90 index 0b7fb49afbbf096bf39aafdfa0c484af4419cb4b..f8c7ed7d7616f7cd532bc46ca65dfca62d59e1c6 100644 --- a/modules_comptage.f90 +++ b/modules_comptage.f90 @@ -18,8 +18,8 @@ use module_mpi, only:aretes_loc,aretes_bord,nb_elt_proc,me,elt_voisins,vecteur_message,np,ne_loc,& &nab,naloc,elt_bord,vecteur_reception,nbouvloc,nouvb,ouvrages_loc,ouvrages_bord,nbouv_b_loc,ouvragesb_loc& - &,machine,deplacement_elt_proc,message,message_tableau_aretes,message_logical,nmv,message_scribe,nploc,& - &message_scribe2,message_scribe3,machine_ias + &,machine,deplacement_elt_proc,message,message2,message_tableau_aretes,message_logical,nmv,message_scribe,nploc,& + &message_scribe2,message_scribe3,machine_ias,message_logical2 implicit none ! np: nombre de processeurs, ou de machines @@ -240,7 +240,9 @@ allocate(message_scribe2(ne_loc(me))) allocate(message_scribe3(ne_loc(me))) allocate(message(size(vecteur_message))) + allocate(message2(size(vecteur_message))) allocate(message_logical(size(vecteur_message))) + allocate(message_logical2(size(vecteur_message))) allocate(message_tableau_aretes(size(vecteur_message),4)) deplacement_elt_proc(0)=0 do i=1,nploc @@ -333,40 +335,40 @@ card = ne/np surplus = mod(ne, np) - k=1 ! compteur des mailles globales - do i=0,np-1 - if (i<surplus) then - do j=1,card+1 - machine(k)=i ! numero de la machine que traite la maille k - ne_loc(i)=ne_loc(i)+1 ! nombre de mailles traitées par la machine i - k=k+1 - end do - else - do j=1,card - machine(k)=i - ne_loc(i)=ne_loc(i)+1 - k=k+1 - end do - end if - end do - -! allocate(plop(ne)) -! -! if(me==scribe)then -! do i=1,ne -! 567 k=int(rand(0)*(np)) -! if (k==np) goto 567 -! plop(i)=k -! end do -! endif -! call mpi_barrier(mpi_comm_world,statinfo) -! call mpi_bcast(plop,ne,mpi_integer,scribe,mpi_comm_world,statinfo) -! -! machine(1:ne)=plop(1:ne) -! -! do i=1,ne -! ne_loc(machine(i))=ne_loc(machine(i))+1 +! k=1 ! compteur des mailles globales +! do i=0,np-1 +! if (i<surplus) then +! do j=1,card+1 +! machine(k)=i ! numero de la machine que traite la maille k +! ne_loc(i)=ne_loc(i)+1 ! nombre de mailles traitées par la machine i +! k=k+1 +! end do +! else +! do j=1,card +! machine(k)=i +! ne_loc(i)=ne_loc(i)+1 +! k=k+1 +! end do +! end if ! end do + + allocate(plop(ne)) + + if(me==scribe)then + do i=1,ne + 567 k=int(rand(0)*(np)) + if (k==np) goto 567 + plop(i)=k + end do + endif + call mpi_barrier(mpi_comm_world,statinfo) + call mpi_bcast(plop,ne,mpi_integer,scribe,mpi_comm_world,statinfo) + + machine(1:ne)=plop(1:ne) + + do i=1,ne + ne_loc(machine(i))=ne_loc(machine(i))+1 + end do ne_loc(scribe)=1 @@ -622,8 +624,8 @@ compteur_message=0 compteur_reception=0 - allocate(deplacement_message_c(0:nploc-1)) - allocate(deplacement_reception_c(0:nploc-1)) + allocate(deplacement_message_c(0:nploc)) + allocate(deplacement_reception_c(0:nploc)) allocate(nb_elt_message_c(0:nploc-1)) allocate(nb_elt_reception_c(0:nploc-1)) diff --git a/rubar20.f90 b/rubar20.f90 index 33eaef55844a9c13a84d8ce7c84ff737396dba72..3db8f3c3f408f53639b940236fe8ec64498b9585 100644 --- a/rubar20.f90 +++ b/rubar20.f90 @@ -7023,7 +7023,7 @@ end if end do - if (size(vecteur_message_c)>=1.or.size(vecteur_reception_c>=1) + if (size(vecteur_message_c)>=1.or.size(vecteur_reception_c)>=1)then call message_group_calcul_c(het) call message_group_calcul_c(quet) call message_group_calcul_c(qvet) diff --git a/rubar20_final.f90 b/rubar20_final.f90 index 13860723721361bb5f1232098641cfd0f9b2be40..6859a65b6e6f45f6cc591a511733d4d10aacc290 100644 --- a/rubar20_final.f90 +++ b/rubar20_final.f90 @@ -24,7 +24,7 @@ !include 'rubar20_common.for' ! variables locales - integer :: i, ibouv, ie, je, iouv, isor + integer :: i, ibouv, ie, je, iouv, isor real(wp) :: fm1, nu2, q, volf, volp, volt real(wp) :: volume integer,dimension(mpi_status_size)::status @@ -643,8 +643,8 @@ deallocate(ouvrages_loc,ouvrages_bord) deallocate(elt_voisins,vecteur_message) deallocate(elt_bord,vecteur_reception) - deallocate(deplacement_elt_proc,message,message_tableau_aretes) - deallocate(message_logical) + deallocate(deplacement_elt_proc,message,message2,message_tableau_aretes) + deallocate(message_logical,message_logical2) deallocate(machine_ias) deallocate(deplacement_message_c,deplacement_reception_c) deallocate(nb_elt_message_c,nb_elt_reception_c) diff --git a/rubar20_init.f90 b/rubar20_init.f90 index 9656744ecc09414471a531a0eaa3e9b05a7e3dd1..90ae507c560ea8eef52b868a3f68aa67155dc905 100644 --- a/rubar20_init.f90 +++ b/rubar20_init.f90 @@ -193,12 +193,7 @@ if (nob>0) then allocate(procouvb(nob)) do ibouv=1,nob - do i=0,np-2 - if(ibouv>deplacements3(i+1).and.ibouv<=deplacements3(i+2))then - procouvb(ibouv)=i -! le process qui traite l'ouvrage ibouv est celui qui contient la maille 1 de l'ouvrage (arbitrairement) - end if - end do + procouvb(ibouv)=machine(ie1(ouv(ibouv))) end do end if