diff --git a/code/module_messages.f90 b/code/module_messages.f90 index 55760d5ff7308f1b78f4040161c62d3e6043d936..37ef1bb43b153e269fe525796022ef05927e6af5 100644 --- a/code/module_messages.f90 +++ b/code/module_messages.f90 @@ -82,7 +82,7 @@ module module_messages ! envoie les valeurs sur les noeuds au scribe !-------------------------------------------------------------------- use module_mpi,only:np,nnloc,noeuds_loc,nb_noeuds_recus,deplacements3,& - &me,scribe,statinfo,message_scribe4,noeuds_loc_all,reception_scribe + &me,scribe,statinfo,message_scribe4,noeuds_loc_all,reception_scribe4 use mpi @@ -98,19 +98,53 @@ module module_messages end do !--envoie/reception--! - call mpi_gatherv(message_scribe4(1:nnloc),nnloc,mpi_real8,reception_scribe,& + call mpi_gatherv(message_scribe4(1:nnloc),nnloc,mpi_real8,reception_scribe4,& &nb_noeuds_recus,deplacements3,mpi_real8,scribe,mpi_comm_world,statinfo) !--tri--! if(me==scribe)then do jn=1,size(noeuds_loc_all) in=noeuds_loc_all(jn) - vecteur(in)=reception_scribe(jn) + vecteur(in)=reception_scribe4(jn) end do end if end subroutine message_gatherv3 + subroutine message_gatherv_nbcou(vecteur) +!-------------------------------------------------------------------- +! envoie les valeurs sur les noeuds au scribe +!-------------------------------------------------------------------- + use module_mpi,only:np,nnloc,noeuds_loc,nb_noeuds_recus,deplacements3,& + &me,scribe,statinfo,message_scribe4int,noeuds_loc_all,reception_scribe4int + + use mpi + + implicit none + + integer,dimension(:),intent(inout)::vecteur + integer::in,jn + + !--creation du vecteur message--! + do jn=1,nnloc + in=noeuds_loc(jn) + message_scribe4int(jn)=vecteur(in) + end do + + !--envoie/reception--! + call mpi_gatherv(message_scribe4int(1:nnloc),nnloc,mpi_int,reception_scribe4int,& + &nb_noeuds_recus,deplacements3,mpi_int,scribe,mpi_comm_world,statinfo) + + !--tri--! + if(me==scribe)then + do jn=1,size(noeuds_loc_all) + in=noeuds_loc_all(jn) + vecteur(in)=reception_scribe4int(jn) + end do + end if + + end subroutine message_gatherv_nbcou + subroutine message_gatherv_eau(vecteur) !-------------------------------------------------------------------- diff --git a/code/modules.f90 b/code/modules.f90 index 6aa34d48db0eb11665cb0794e6bf0fa06459f16e..9c36af5715a603242117c92a8ce537820e51bd46 100644 --- a/code/modules.f90 +++ b/code/modules.f90 @@ -273,6 +273,7 @@ real(wp),dimension(:),allocatable::message,message2 real(wp),dimension(:),allocatable::message_scribe,message_scribe2,message_scribe4 real(wp),dimension(:),allocatable::reception_scribe,reception_scribe2,reception_scribe4 + integer,dimension(:),allocatable::reception_scribe4int,message_scribe4int logical,dimension(:),allocatable::message_scribe3,reception_scribe3 integer,dimension(:),allocatable::deplacement_send_proc,deplacement_recv_proc logical,dimension(:),allocatable::message_logical,message_logical2 diff --git a/code/modules_comptage.f90 b/code/modules_comptage.f90 index 4f987b1ef7084bd766be0de9dcd82747c1f2ef51..166187f5ec6a17cffc328cdad4b9fe14090db7fb 100644 --- a/code/modules_comptage.f90 +++ b/code/modules_comptage.f90 @@ -26,7 +26,7 @@ &,machine,deplacement_recv_proc,deplacement_send_proc,message,message2& &,message_logical,nmv,message_scribe,nploc,& &message_scribe2,message_scribe3,machine_ias,message_logical2,& - &message_scribe4 + &message_scribe4,message_scribe4int implicit none ! np: nombre de processeurs, ou de machines @@ -433,6 +433,7 @@ allocate(message_scribe2(ne_loc(me))) allocate(message_scribe3(ne_loc(me))) allocate(message_scribe4(nnloc)) + allocate(message_scribe4int(nnloc)) allocate(message(size(vecteur_message))) allocate(message2(size(vecteur_reception))) allocate(message_logical(size(vecteur_message))) @@ -513,7 +514,7 @@ !-------------------------------------------------------------------- use module_mpi,only:machine,ne_loc,mailles_loc,scribe,statinfo - use module_tableaux,only:debglo,debtar,nob,xe,ye,nn,nne,ine + use module_tableaux,only:debglo,debtar,nob,xe,ye,nn,nne,ine,nbouv use iso_c_binding implicit none @@ -569,10 +570,11 @@ ! call indexArrayReal(ne, xe, itri) ! xe(:)=xe(:)*(-1) k=1 ! compteur des mailles globales +! do i=np-1,0,-1 do i=0,np-1 if (i<surplus) then do j=1,card+1 -! machine(itri(k))=i ! numero de la machine qui traite la maille k +! ! machine(itri(k))=i ! numero de la machine qui traite la maille k machine(k)=i ! numero de la machine qui traite la maille k ne_loc(i)=ne_loc(i)+1 ! nombre de mailles traitées par la machine i k=k+1 @@ -686,6 +688,7 @@ ! end do if(debglo.or.debtar) call groupes_aretes + if(nbouv>0) call repouv if(nob>1) call repouvb if((debglo.or.debtar).and.nob>1) call verif_groupes_aretes @@ -712,7 +715,8 @@ &deplacements2,statinfo,noeuds_loc_all,aretes_loc_all,ouvragesb_loc,& &message_scribe,mailles_loc_all,message_scribe2,message_scribe3,ne_loc,& &nb_mailles_recues,reception_scribe,reception_scribe2,reception_scribe3,& - &naloc,nnloc,nbouv_b_loc,deplacements3,reception_scribe4 + &naloc,nnloc,nbouv_b_loc,deplacements3,reception_scribe4,& + &reception_scribe4int use module_tableaux, only:ntrmax @@ -763,6 +767,7 @@ allocate(reception_scribe2(deplacements(np)+ne_loc(np-1))) allocate(reception_scribe3(deplacements(np)+ne_loc(np-1))) allocate(reception_scribe4(deplacements3(np)+nb_noeuds_recus(np))) + allocate(reception_scribe4int(deplacements3(np)+nb_noeuds_recus(np))) else allocate(nb_mailles_recues(0),deplacements(0)) allocate(nb_aretes_recues(0),deplacements2(0)) @@ -776,6 +781,7 @@ allocate(reception_scribe2(0)) allocate(reception_scribe3(0)) allocate(reception_scribe4(0)) + allocate(reception_scribe4int(0)) endif ! exemple: @@ -861,7 +867,7 @@ ! l'ouvrage B suivant est donné au process qui traite l'ouvrage B courant !-------------------------------------------------------------------- - use module_tableaux,only:nbouv,nouv,ouv,ie1,suivan,nob + use module_tableaux,only:nbouv,nouv,ouv,ie1,ie2,suivan,nob use module_mpi,only:machine,ne_loc implicit none @@ -878,11 +884,45 @@ ne_loc(machine(ie))=ne_loc(machine(ie))+1 end if end if + ! on donne toutes les breches au proc 0 +! ne_loc(machine(ie1(ouv(ibouv))))=ne_loc(machine(ie1(ouv(ibouv))))-1 +! machine(ie1(ouv(ibouv)))=0 +! ne_loc(0)=ne_loc(0)+1 +! ne_loc(machine(ie2(ouv(ibouv))))=ne_loc(machine(ie2(ouv(ibouv))))-1 +! machine(ie2(ouv(ibouv)))=0 +! ne_loc(0)=ne_loc(0)+1 end do end subroutine repouvb + subroutine repouv +!-------------------------------------------------------------------- +! boucle sur les ouvrages: +! ouvrage traité par un seul proc +!-------------------------------------------------------------------- + + use module_tableaux,only:nbouv,nouv,ouv,ie1,ie2,suivan,nob + use module_mpi,only:machine,ne_loc + + implicit none + + integer::ibouv,i1,iee,i2 + + do ibouv=1,nbouv + i1=ie1(ouv(ibouv)) + i2=ie1(ouv(ibouv)) + if (machine(i1)/=machine(i2))then + print*,"relocate second cell of ouv ",ibouv + ne_loc(machine(i2))=ne_loc(machine(i2))-1 + machine(i2)=machine(i1) + ne_loc(machine(i1))=ne_loc(machine(i1))+1 + end if + end do + + end subroutine repouv + + subroutine verif_groupes_aretes !-------------------------------------------------------------------- ! Vérification que toutes les aretes d'un groupe sont traitées par la même machine diff --git a/code/rubar20.f90 b/code/rubar20.f90 index 812bf11dd166195c10e6a3c47e11ad43f94b6c0c..83ae64d1dea75737811f8cfb44630749f108bb5d 100644 --- a/code/rubar20.f90 +++ b/code/rubar20.f90 @@ -541,7 +541,8 @@ !$omp end master !$omp end parallel ! boucle sur t : tant que t <= tfin faire ... - 100 t=tm+dt + do + t=tm+dt ! test d arret sur t par rapport a tfin if (t > tfin) then @@ -582,8 +583,9 @@ #ifdef WITH_MPI call message_gatherv (hae) #if TRANSPORT_SOLIDE - call message_gatherv2 (dhe) call message_gatherv2 (cet) + call message_gatherv3(zfn) + call message_gatherv3(dzfn) ! if(solute)then ! write(*,*) 'Transmission Dhe' call message_gatherv2(dhe) @@ -595,8 +597,17 @@ if(sedvar)then ! write(*,*) 'Transmission diamètre' call message_gatherv2(diame) + call message_gatherv(diama) ! write(*,*) 'Transmission Etendue' call message_gatherv2(sigmae) + call message_gatherv(sigmaa) + call message_gatherv_nbcou(nbcoun) + do i=1,10 + call message_gatherv3(epcoun(:,i)) + call message_gatherv3(diamn(:,i)) + call message_gatherv3(sigman(:,i)) + call message_gatherv3(taummn(:,i)) + enddo endif #endif ! endif @@ -1292,10 +1303,6 @@ call message_gatherv(fha) call message_gatherv(mess_qouv1) call message_gatherv(mess_qouv2) -#if TRANSPORT_SOLIDE - call message_gatherv3(zfn) - call message_gatherv3(dzfn) -#endif if (ifm.gt.0)then call message_gatherv2(he) call message_gatherv_eau(eau) @@ -1340,7 +1347,7 @@ end if #endif /* WITH_MPI */ ! calcul pour un nouveau temps - go to 100 + enddo end subroutine calcdt @@ -1409,6 +1416,8 @@ call message_gatherv2(cet) call message_gatherv (hae) call message_gatherv2 (zfe) + call message_gatherv3(zfn) + call message_gatherv3(dzfn) ! if(solute)then ! write(*,*) 'Transmission Dhe' @@ -1421,8 +1430,17 @@ if(sedvar)then ! write(*,*) 'Transmission diamètre' call message_gatherv2(diame) + call message_gatherv(diama) ! write(*,*) 'Transmission Etendue' call message_gatherv2(sigmae) + call message_gatherv(sigmaa) + call message_gatherv_nbcou(nbcoun) + do i=1,10 + call message_gatherv3(epcoun(:,i)) + call message_gatherv3(diamn(:,i)) + call message_gatherv3(sigman(:,i)) + call message_gatherv3(taummn(:,i)) + enddo endif #endif ! endif @@ -1445,7 +1463,7 @@ call mpi_allreduce(tini(ibouv),tini(ibouv),1,mpi_real8,mpi_min,mpi_comm_world,statinfo) !i = int((tm-tini(ibouv))/dt2(ibouv)) + 1! !if (i.le.ntrmax .and. tm.ge.tini(ibouv)) then - if(me==procouvb(ibouv))then + if(me==procouvb(ibouv) .and. me .ne. scribe)then call mpi_send(z(:,ibouv),ntrmax,mpi_real8,scribe,51,mpi_comm_world,statinfo) call mpi_send(zbr(:,ibouv),ntrmax,mpi_real8,scribe,52,mpi_comm_world,statinfo) call mpi_send(dbr(:,ibouv),ntrmax,mpi_real8,scribe,53,mpi_comm_world,statinfo) @@ -1458,7 +1476,7 @@ call mpi_send(kappa(ibouv),1,mpi_logical,scribe,60,mpi_comm_world,statinfo) call mpi_send(it(ibouv),1,mpi_integer,scribe,61,mpi_comm_world,statinfo) end if ! me==0 - if(me==scribe)then + if(me .ne. procouvb(ibouv) .and. me==scribe)then call mpi_recv(z(:,ibouv),ntrmax,mpi_real8,procouvb(ibouv),51,mpi_comm_world,status,statinfo) call mpi_recv(zbr(:,ibouv),ntrmax,mpi_real8,procouvb(ibouv),52,mpi_comm_world,status,statinfo) call mpi_recv(dbr(:,ibouv),ntrmax,mpi_real8,procouvb(ibouv),53,mpi_comm_world,status,statinfo) @@ -1573,7 +1591,7 @@ ! if(conckg)then ! write(id_tpc,'(8f10.5)') ! :(min(cet(ie)*dens,9999.999d0),ie=1,ne) -!! write(id_tpc,'(8f10.6)') (cet(ie)*dens,ie=1,ne) +! ! write(id_tpc,'(8f10.6)') (cet(ie)*dens,ie=1,ne) ! else ! write(id_tpc,'(8f10.7)') ! :(min(cet(ie),99.99999d0),ie=1,ne) @@ -14486,77 +14504,75 @@ ! nbmail : nombre de mailles interne a l'ouvrage ! si nbmail=0 on a normalement ia1=ia2 read(idon,*,err=5,end=8)xia1,yia1,xie1,yie1,nref,nbmail - if (me==scribe)then - write(*,*)'lecture de l''ouvrage',iouv - end if ! me==scribe + if (me==scribe)then + write(*,*)'lecture de l''ouvrage',iouv + end if ! me==scribe call trxyia(xia1,yia1,ia1(iouv),trouve) if (trouve) then - trouve=.false. - if (nref.eq.-1.and.nrefa(ia1(iouv)) .gt. 0) then - if (me==scribe)then + trouve=.false. + if (nref.eq.-1.and.nrefa(ia1(iouv)) .gt. 0) then + if (me==scribe)then write(*,*)'ouvrage ',iouv write(*,*)'reference -1 impossible sur une frontiere' - end if ! me==scribe - stop - elseif (nrefa(ia1(iouv)).eq.-1) then - if (me==scribe)then - write(*,*)'ouvrage ',iouv - write(*,*)'2 ouvrages sur une meme arete 1 impossible' - end if ! me==scribe - stop - endif - nrefa(ia1(iouv))=nref - else - if(me==scribe)write(*,*)'les coordonnees de l''arete 1',& - &' sont fausses' + end if ! me==scribe + stop + elseif (nrefa(ia1(iouv)).eq.-1) then + if (me==scribe)then + write(*,*)'ouvrage ',iouv + write(*,*)'2 ouvrages sur une meme arete 1 impossible' + end if ! me==scribe stop + endif + nrefa(ia1(iouv))=nref + else + if(me==scribe)write(*,*)'les coordonnees de l''arete 1',& + &' sont fausses' + stop endif call trxyix(xie1,yie1,ie1(iouv),trouve) if (trouve) then - trouve=.false. + trouve=.false. else - if(me==scribe)write(*,*)'les coordonnees de la maille 1',& - &' sont fausses' - stop + if(me==scribe)write(*,*)'les coordonnees de la maille 1',& + &' sont fausses' + stop endif if (nbmail.ne.0) then - do 2 i=1,nbmail - read(idon,*,err=5)xiei,yiei - call trxyie(xiei,yiei,nref,trouve) - if (trouve) then - trouve=.false. -! k=k+1 - else - if(me==scribe)write(*,*)'les coordonnees d''une maille interne d''un',& - &' ouvrage sont fausses' - stop - endif - 2 continue + do 2 i=1,nbmail + read(idon,*,err=5)xiei,yiei + call trxyie(xiei,yiei,nref,trouve) + if (trouve) then + trouve=.false. +! k=k+1 + else + if(me==scribe)write(*,*)'les coordonnees d''une maille interne d''un',& + &' ouvrage sont fausses' + stop + endif + 2 continue endif ! nouv nombre d'ouvrages elementaires read (idon,*,err=5)xia2,yia2,xie2,yie2,nouv(iouv) if (nouv(iouv) .gt. noemax) then - if(me==scribe)write(*,*)'trop d''ouvrages elementaires : nombre limite a'& - &,noemax + if(me==scribe)write(*,*)'trop d''ouvrages elementaires : nombre limite a',noemax endif call trxyia(xia2,yia2,ia2(iouv),trouve) if (trouve) then - trouve=.false. - if (nref.eq.-1.and.nrefa(ia2(iouv)) .gt. 0) then - if(me==scribe)write(*,*)'ouvrage ',iouv - if(me==scribe)write(*,*)'reference -1 impossible sur une frontiere' - stop - elseif (nrefa(ia2(iouv)).eq.-1& - &.and.ia1(iouv).ne.ia2(iouv)) then - if(me==scribe)write(*,*)'ouvrage ',iouv - if(me==scribe)write(*,*)'2 ouvrages sur une meme arete 2 impossible' - stop - endif - nrefa(ia2(iouv))=nref + trouve=.false. + if (nref.eq.-1.and.nrefa(ia2(iouv)) .gt. 0) then + if(me==scribe)write(*,*)'ouvrage ',iouv + if(me==scribe)write(*,*)'reference -1 impossible sur une frontiere' + stop + elseif (nrefa(ia2(iouv)).eq.-1.and.ia1(iouv).ne.ia2(iouv)) then + if(me==scribe)write(*,*)'ouvrage ',iouv + if(me==scribe)write(*,*)'2 ouvrages sur une meme arete 2 impossible' + stop + endif + nrefa(ia2(iouv))=nref else - if(me==scribe)write(*,*)'les coordonnees de l''arete 2 ne correspondent pas a une arete' - if(me==scribe)write(*,*)'on prend une arete nulle soit une sortie du modele' - ia2(iouv)=0 + if(me==scribe)write(*,*)'les coordonnees de l''arete 2 ne correspondent pas a une arete' + if(me==scribe)write(*,*)'on prend une arete nulle soit une sortie du modele' + ia2(iouv)=0 endif call trxyix(xie2,yie2,ie2(iouv),trouve) if (trouve) then @@ -18833,6 +18849,7 @@ !desallocation des tableaux du module_mpi deallocate(aretes_loc) deallocate(message_scribe,message_scribe2,message_scribe3) + deallocate(message_scribe4,message_scribe4int) deallocate(ouvragesb_loc) deallocate(nb_elt_send_proc,nb_elt_recv_proc) if (nob>0) deallocate(procouvb) @@ -18851,7 +18868,7 @@ !end if ! me/=scribe #ifdef WITH_MPI deallocate(aretes_loc_all,mailles_loc_all,noeuds_loc_all) - deallocate(reception_scribe,reception_scribe2,reception_scribe3,reception_scribe4) + deallocate(reception_scribe,reception_scribe2,reception_scribe3,reception_scribe4,reception_scribe4int) deallocate(deplacements,deplacements2,deplacements3) deallocate(nb_aretes_recues,nb_mailles_recues,nb_noeuds_recus) #endif /* WITH_MPI */ @@ -19503,97 +19520,98 @@ #if SEDVAR if(sedvar)then ! si erosion - if(eseldt(ie).lt.-eps2)then + if(eseldt(ie).lt.-eps2)then erosion=.true. - if(taue(ie).lt.taummn(in,1))then - if(modes.and.(.not.camenen))then - erosion=.false. - elseif(meyer.and.(.not.camenen))then - erosion=.false. + if(taue(ie).lt.taummn(in,1))then + if(modes.and.(.not.camenen))then + erosion=.false. + elseif(meyer.and.(.not.camenen))then + erosion=.false. + endif endif - endif ! ! si tau superieur a taummn ! if(taue(ie).gt.taummn(in,1))then - if(erosion)then - if(dhn(in).lt.-eps2)then - dhn(in)=-dhn(in) - call melangeds(dhn(in),-eseldt(ie)& - &,diamdhn(in),sigmadhn(in),diame2(ie),sigmae2(ie)) - dhn(in)=-dhn(in) + if(erosion)then + if(dhn(in).lt.-eps2)then + dhn(in)=-dhn(in) + call melangeds(dhn(in),-eseldt(ie)& + &,diamdhn(in),sigmadhn(in),diame2(ie),sigmae2(ie)) + dhn(in)=-dhn(in) ! si dhn positif - elseif(dhn(in).gt.eps2)then - if(dhn(in).gt.-eseldt(ie))then - call dmelangeds(dhn(in),-eseldt(ie)& - &,diamdhn(in),sigmadhn(in),diame2(ie),sigmae2(ie),ie) - else + elseif(dhn(in).gt.eps2)then + if(dhn(in).gt.-eseldt(ie))then + call dmelangeds(dhn(in),-eseldt(ie),diamdhn(in)& + &,sigmadhn(in),diame2(ie),sigmae2(ie),ie) + else ! dhn positif mais plus petit que -eseldt - m=-eseldt(ie) - dm=diame2(ie) - sm=sigmae2(ie) - call dmelangeds(m,dhn(in)& - &,dm,sm,diamdhn(in),sigmadhn(in),ie) - dhn(in)=-m - diamdhn(in)=dm - sigmadhn(in)=sm + m=-eseldt(ie) + dm=diame2(ie) + sm=sigmae2(ie) + call dmelangeds(m,dhn(in)& + &,dm,sm,diamdhn(in),sigmadhn(in),ie) + dhn(in)=dhn(in)-m + diamdhn(in)=dm + sigmadhn(in)=sm ! fin du if sur dhn/eseldt - endif + endif ! le else veut dire taue inferieur a taummn ! pour les cas ou cela compte - else + else ! dhn=0 - dhn(in)=eseldt(ie) - diamdhn(in)=diame2(ie) - sigmadhn(in)=sigmae2(ie) + dhn(in)=dhn(in)+eseldt(ie) + diamdhn(in)=diame2(ie) + sigmadhn(in)=sigmae2(ie) ! fin du if sur dhn - endif + endif ! dhn(in)=dhn(in)+eseldt(ie) ! dans le cas contraire dhn additionnel=0 ! fin du if sur tau - endif + endif ! si depot elseif(eseldt(ie).gt.eps2)then - if(dhn(in).gt.eps2)then - call melangeds(dhn(in),eseldt(ie)& - &,diamdhn(in),sigmadhn(in),diame2(ie),sigmae2(ie)) - elseif(dhn(in).lt.-eps2)then - if(dhn(in).lt.-eseldt(ie))then - m=-dhn(in) - call dmelangeds(m,eseldt(ie)& - &,diamdhn(in),sigmadhn(in),diame2(ie),sigmae2(ie),ie) - dhn(in)=-m + if(dhn(in).gt.eps2)then + call melangeds(dhn(in),eseldt(ie),diamdhn(in)& + &,sigmadhn(in),diame2(ie),sigmae2(ie)) + elseif(dhn(in).lt.-eps2)then + if(dhn(in).lt.-eseldt(ie))then + m=-dhn(in) + call dmelangeds(m,eseldt(ie),diamdhn(in)& + &,sigmadhn(in),diame2(ie),sigmae2(ie),ie) + dhn(in)=dhn(in)-m ! dhn plus petit que esleldt else - m=eseldt(ie) - dm=diame2(ie) - sm=sigmae2(ie) - call dmelangeds(m,-dhn(in)& - &,dm,sm,diamdhn(in),sigmadhn(in),ie) - dhn(in)=-m - diamdhn(in)=dm - sigmadhn(in)=sm + m=eseldt(ie) + dm=diame2(ie) + sm=sigmae2(ie) + call dmelangeds(m,-dhn(in)& + &,dm,sm,diamdhn(in),sigmadhn(in),ie) + dhn(in)=dhn(in)-m + diamdhn(in)=dm + sigmadhn(in)=sm ! fin du if sur eseldt/dhn endif - else + else ! dhn=0 - dhn(in)=eseldt(ie) - diamdhn(in)=diame2(ie) - sigmadhn(in)=sigmae2(ie) + dhn(in)=dhn(in)+eseldt(ie) + diamdhn(in)=diame2(ie) + sigmadhn(in)=sigmae2(ie) ! fin du if sur dhn - endif + endif ! fin du if sur erosion endif - hcn(in)=hcn(in)+hcet(ie) + hcn(in)=hcn(in)+hcet(ie) else #endif dhn(in)=dhn(in)+eseldt(ie) #if SEDVAR - endif + endif !end if sedvar #endif - enddo - enddo + enddo + enddo + do jn=1,nnloc in=noeuds_loc(jn) @@ -19674,6 +19692,9 @@ enddo zfe2(ie)=zfe2(ie)/float(nne(ie)) + enddo + do ieloc = 1,ne_loc(me) + ie = mailles_loc(ieloc) ! dhe2(ie)=dhe2(ie)/float(nne(ie)) ! calcul de la variation de cote du fond dhe(ie)=zfe2(ie)-zfe(ie) @@ -19684,11 +19705,11 @@ zfe2(ie)=zfe(ie) dhe(ie)=0. #if SEDVAR - if(sedvar)then + if(sedvar)then diamsmb(ie)=diamn(ie1,1) sigmasmb(ie)=sigman(ie1,1) ! fin du if sur sedvar - endif + endif !end if sedvar #endif @@ -19741,6 +19762,7 @@ ! cofr2(ie) = abs(se(ie)/cofr2(ie)) ! se(ie) = 0.5*abs(se(ie)) enddo + ! on applique le depot aux sommets concernés #if SEDVAR if(sedvar)then @@ -20355,7 +20377,7 @@ end &,taummn2,epcoun2,taummn,sigmasmb,modifz - use module_mpi,only:ne_loc,me,mailles_loc,nnloc,noeuds_loc + use module_mpi,only:ne_loc,me,mailles_loc,nnloc,noeuds_loc,nmv,elt_voisins implicit none integer ie,in,jn,kn @@ -22223,12 +22245,15 @@ use module_precision use module_tableaux,only:eau,ne,na,nn,zfa,zfe,zfm,iae,nne& &,eps1,eps2,paray,xn,yn,se,la,dt,cfl,dt0,t,zfn,ina,ine - use module_ts,only:eseldt,diame2,sigmae2,epcoun,diamn,sigman,taummn& + use module_ts,only:eseldt,epcoun,diamn,sigman,taummn& &,nbcoun,sigma0,taun,dhe,zfndur& &,cofr2,zfn2,zfa2,zfe2& &,diamnt,sigmant,nbcoun2 use module_mpi, only:noeuds_loc,aretes_loc,mailles_loc,naloc,ne_loc& &,nnloc,me,nmv,elt_voisins +#ifdef WITH_MPI + use module_messages +#endif #if SEDVAR use module_ts,only:sedvar,diamdhn,sigmadhn,diamsmb,sigmasmb& @@ -22355,6 +22380,10 @@ use module_precision if(sedvar)then diamsmb(ie)=diamn(ie1,1) sigmasmb(ie)=sigman(ie1,1) +#ifdef WITH_MPI +! call message_group_calcul(diamsmb) +! call message_group_calcul(sigmasmb) +#endif ! fin du if sur sedvar endif !end if sedvar