Commit 12bcc746 authored by Theophile Terraz's avatar Theophile Terraz
Browse files

Merge branch 'master' into CGNS

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