debug MPI

code/Makefile

@@ -36,8 +36,8 @@ USUAL_FLAG =
 OMP_FLAG = -fopenmp
 MPI_FLAG = mpifort -cpp -DWITH_MPI
 # change to debug_flag to enable debug features
-COMPILE_FLAG = $(OPTIM_FLAG)
-# COMPILE_FLAG = $(DEBUG_FLAG)
+# COMPILE_FLAG = $(OPTIM_FLAG)
+COMPILE_FLAG = $(DEBUG_FLAG)
 # METIS_FLAG = -DWITH_METIS
 NB_PROC = 2
 

code/rubar20.f90

@@ -283,6 +283,9 @@
 #endif /* FRA */
       end if ! me==scribe
       call ledd(alpha,nbpt,xnb,ynb,cvi)
+#ifdef WITH_MPI
+      call mpi_bcast(ifm,1,mpi_integer,scribe,mpi_comm_world,i)
+#endif /* WITH_MPI */
 ! lecture/edition donnees maillage
       if (me==scribe)then
@@ -613,7 +616,9 @@
       endif
 #ifdef WITH_MPI
+!    print*,"plop1 proc",me
       call message_gatherv (hae)
+!    print*,"plop2 proc",me
 #if TRANSPORT_SOLIDE
       call message_gatherv2 (cet)
          call message_gatherv3(zfn)
@@ -714,6 +719,7 @@
 !          enddo
          write(id_tps,'(f15.3)')tm
          write(id_tps,'(8f10.5)') (het(ie),ie=1,ne)
+!          call write_contrainte(id_tps)
          write(id_tps,'(8f10.5)') (quet(ie),ie=1,ne)
          write(id_tps,'(8f10.5)') (qvet(ie),ie=1,ne)
 #if WITH_CGNS
@@ -1344,9 +1350,9 @@
       if(me/=scribe)then
-      if (ifen > 0) then
-         call lenv
-      endif
+        if (ifen > 0) then
+          call lenv
+        endif
       end if ! me/=scribe
@@ -1360,9 +1366,9 @@
          call message_gatherv2(qvet)
        end if
-
+!
        if ((tm.ge.tr .or. tm+dt>=tfin) .and. ifen>0) then
-         call message_gatherv2(th)
+!          call message_gatherv2(th)
          call message_gatherv2(hem)
          call message_gatherv2(hem2)
          call message_gatherv2(tu)
@@ -9864,6 +9870,9 @@
       use module_tableaux
       use module_loc, only:hem,qum,qvm,hem2,qum2,qvm2,th,tu
       use module_mpi,only:me,scribe,ne_loc,mailles_loc
+#ifdef WITH_MPI
+      use module_messages
+#endif /* WITH_MPI */
 !$    use omp_lib
       implicit none
@@ -9949,7 +9958,7 @@
 !       if (me/=scribe)then
 !$omp parallel private(vx,vy)
 !$omp do schedule(runtime)
-      do ieloc = 1,ne_loc(me)
+        do ieloc = 1,ne_loc(me)
           ie=mailles_loc(ieloc)
           if(het(ie).gt.paray)then
             if (het(ie) .gt. hem(ie)) then
@@ -9969,10 +9978,22 @@
                tu(ie) = tm
             endif
           endif
-      enddo
+        enddo
 !$omp end do
 !$omp end parallel
 !       end if !if me/=scribe
+#ifdef WITH_MPI
+       if ((tm.ge.tr .or. tm.eq.tmax) .and. ifen>0) then
+         call message_gatherv2(th)
+         call message_gatherv2(hem)
+         call message_gatherv2(hem2)
+         call message_gatherv2(tu)
+         call message_gatherv2(qum)
+         call message_gatherv2(qum2)
+         call message_gatherv2(qvm)
+         call message_gatherv2(qvm2)
+       end if
+#endif /* WITH_MPI */
 ! ecriture sur etude.env en meme temps qu'ecriture sur tps
       if (me==scribe)then
       if (tm.ge.tr .or. tm.eq.tmax) then
@@ -19263,6 +19284,7 @@
      use module_tableaux,only:ne,na,nn,eau,het,quet,qvet,fra,fre,cofr&
      &,ieva,iae,nne,g,smbh,zfn,dt,cfl,dt0,t,eps1,eps2,paray,idl
+      use module_precision,only:wp
      use module_ts,only : efficace,sigma0,rapsmbhc,nbcoun,epcoun,diamn,sigman&
      &,taummn,diame2,sigmae2,exposantaucr,camenen,hansen,exptaucr,taue,rapva,smbhc&
@@ -19279,7 +19301,7 @@
 #endif /* WITH_MPI */
       use module_mpi,only:ne_loc,me,mailles_loc,naloc,aretes_loc
-     !  implicit none
+      implicit none
 !!!!!     real(WP),intent(inout) :: cofr2(ne),zfn2(nn),zfa2(na),zfe2(ne)!,ceq(ne)
      real(WP) :: rapve(ne),vitchut2
@@ -22851,4 +22873,35 @@ use module_precision
       end
 #endif /* fin section transport solide */
+!       subroutine write_contrainte(id_tps)
+!       use module_tableaux,only:ne,het,fra,fre,quet,qvet,paray,g,cofr
+!       use module_precision,only:wp
+!       implicit none
+!       real(WP) :: q,vstar,fra2,vfr
+!       integer,intent(in) :: id_tps
+!       integer :: ie
+!       real(WP), dimension(:),allocatable :: vitfro
+!
+!       allocate(vitfro(ne))
+!       do ie=1,ne
+!         if(het(ie).gt.paray)then
+!           q=sqrt(quet(ie)**2+qvet(ie)**2)
+!           vstar=q/het(ie)
+! ! on limite la vitesse
+!           if(vstar.gt.10.)vstar=10.
+! ! calcul du coefficient de chezy
+!           fra2=max(fra(ie),fre(ie)*het(ie)**0.3333333)
+! ! on divise par cofr car la surface est integree dans fra ou fre
+!           fra2=fra2/cofr(ie)
+! ! calcul de la vitesse de frottement
+!           vfr= sqrt(g)*vstar/sqrt(fra2)
+!           vitfro(ie)=vfr
+!         else
+!           vitfro(ie)=0.
+!         endif
+!       enddo
+!       deallocate(vitfro)
+!       write(id_tps,'(8f10.5)') (vitfro(ie),ie=1,ne)
+!       end subroutine write_contrainte
+