N.I.M.R.O.D.  

mpimod.mpi.f90

Go to the documentation of this file.
00001 !------------------------------------------------------------------------------
00002 ! N.I.M.R.O.D. - Normal approximation Inference in Models with Random
00003 !                effects based on Ordinary Differential equations
00004 !------------------------------------------------------------------------------
00005 !
00006 ! VERSION : 1.0
00007 !
00008 ! MODULE: mpimod.mpi.f90
00018 module mpimod
00019    include 'mpif.h'
00021    integer :: numproc,nbprocs,mpierr
00022 
00023    integer, parameter ::MPIutilisation=1
00024    contains
00025 
00026 
00027   !---------------------------------------------------------------------------------
00030      subroutine MPIinitialisation
00031         implicit none
00032         CALL MPI_INIT(mpierr)
00033         CALL MPI_COMM_SIZE(MPI_COMM_WORLD, nbprocs, mpierr)
00034         CALL MPI_COMM_RANK(MPI_COMM_WORLD, numproc, mpierr)
00035 
00036         write (0,*) "processeur",numproc, "de", nbprocs
00037         CALL MPI_BARRIER (MPI_COMM_WORLD, mpierr)
00038      end subroutine MPIinitialisation
00039 
00040   !---------------------------------------------------------------------------------
00043      subroutine MPIfinalisation
00044         implicit none
00045         call MPI_BARRIER (MPI_COMM_WORLD, mpierr)
00046         CALL MPI_FINALIZE(mpierr)
00047      end subroutine MPIfinalisation
00048 
00049   !---------------------------------------------------------------------------------
00059       subroutine repartirSurCoeurs(debut,fin,nbpatient)
00060       implicit none
00061       integer,intent(out) :: debut,fin
00062       integer,intent(in) :: nbpatient
00063       integer :: i,nbpatientminparproc
00064       nbpatientminparproc=floor(real(nbpatient)/real(nbprocs))
00065       if (numproc.LT.(nbprocs-1)) then
00066          debut=int(real(numproc)*real(nbpatientminparproc))+1
00067          fin=int(real(numproc+1)*real(nbpatientminparproc))
00068       end if
00069       if(numproc.EQ.(nbprocs-1)) then
00070          debut=int(real(numproc)*real(nbpatientminparproc))+1
00071          fin=nbpatient
00072       end if
00073       return
00074       end subroutine repartirSurCoeurs
00075 
00076   !---------------------------------------------------------------------------------
00079        subroutine synchroFUNCPA
00080           use WorkingSharedValues
00081           implicit none
00082 
00083           double precision,dimension(nbpatienta) :: reduce1
00084           double precision, dimension(ndim,nbpatienta) :: reduce2
00085           double precision, dimension(ndim,ndim,nbpatienta) :: reduce3
00086           double precision, dimension(3,nbpatienta) :: reduce4
00087           integer, dimension(3,nbpatienta) :: reduce5
00088 
00089           call MPI_BARRIER (MPI_COMM_WORLD, mpierr)
00090           if (nbprocs .gt. 1) then
00091              call MPI_ALLREDUCE (vrais_obs, reduce1, nbpatienta,           &
00092                                  MPI_DOUBLE_PRECISION, MPI_SUM,           &
00093                                   MPI_COMM_WORLD, mpierr)
00094              vrais_obs(1:nbpatienta) = reduce1
00095              call MPIErrorCatch(mpierr)
00096 
00097              call MPI_ALLREDUCE (detersauv, reduce1, nbpatienta,           &
00098                                  MPI_DOUBLE_PRECISION, MPI_SUM,           &
00099                                  MPI_COMM_WORLD, mpierr)
00100              detersauv(1:nbpatienta) = reduce1
00101              call MPIErrorCatch(mpierr)
00102 
00103              call MPI_ALLREDUCE (startsauv, reduce2, ndim*nbpatienta,           &
00104                                   MPI_DOUBLE_PRECISION, MPI_SUM,           &
00105                                   MPI_COMM_WORLD, mpierr)
00106              startsauv(:,1:nbpatienta) = reduce2
00107              call MPIErrorCatch(mpierr)
00108 
00109 
00110              call MPI_ALLREDUCE (likelihoodPRECISION, reduce4, 3*nbpatienta,           &
00111                                   MPI_DOUBLE_PRECISION, MPI_SUM,           &
00112                                   MPI_COMM_WORLD, mpierr)
00113              likelihoodPRECISION(:,1:nbpatienta) = reduce4
00114          call MPIErrorCatch(mpierr)
00115 
00116           call MPI_ALLREDUCE (likelihoodERROR, reduce5, 3*nbpatienta,           &
00117                                   MPI_INTEGER, MPI_SUM,           &
00118                                   MPI_COMM_WORLD, mpierr)
00119              likelihoodERROR(:,1:nbpatienta) = reduce5
00120          call MPIErrorCatch(mpierr)
00121 
00122 
00123              call MPI_ALLREDUCE (extrema, reduce2, ndim*nbpatienta,           &
00124                                   MPI_DOUBLE_PRECISION, MPI_SUM,           &
00125                                   MPI_COMM_WORLD, mpierr)
00126              extrema(:,1:nbpatienta) = reduce2
00127              call MPIErrorCatch(mpierr)
00128 
00129 
00130              call MPI_ALLREDUCE (startsauvind, reduce2, ndim*nbpatienta,           &
00131                                   MPI_DOUBLE_PRECISION, MPI_SUM,           &
00132                                   MPI_COMM_WORLD, mpierr)
00133              startsauvind(:,1:nbpatienta) = reduce2
00134              call MPIErrorCatch(mpierr)
00135 
00136              call MPI_ALLREDUCE (scaleinvsauv, reduce3,           &
00137                                   ndim*ndim*nbpatienta,           &
00138                                   MPI_DOUBLE_PRECISION, MPI_SUM,           &
00139                                   MPI_COMM_WORLD, mpierr)
00140              scaleinvsauv(:,:,1:nbpatienta) = reduce3
00141              call MPIErrorCatch(mpierr)
00142 
00143              call MPI_ALLREDUCE (scaleinv2sauv, reduce3,           &
00144                                   ndim*ndim*nbpatienta,           &
00145                                   MPI_DOUBLE_PRECISION, MPI_SUM,           &
00146                                   MPI_COMM_WORLD, mpierr)
00147              scaleinv2sauv(:,:,1:nbpatienta) = reduce3
00148              call MPIErrorCatch(mpierr)
00149 
00150              call MPI_ALLREDUCE (scalesauv, reduce3,           &
00151                                   ndim*ndim*nbpatienta,           &
00152                                   MPI_DOUBLE_PRECISION, MPI_SUM,           &
00153                                   MPI_COMM_WORLD, mpierr)
00154              scalesauv(:,:,1:nbpatienta) = reduce3
00155              call MPIErrorCatch(mpierr)
00156           end if
00157 
00158           return
00159       end subroutine synchroFUNCPA
00160 
00161   !---------------------------------------------------------------------------------
00164 
00165        subroutine synchroCALCULSCORES(uscore)
00166           use WorkingSharedValues
00167           implicit none
00168           double precision,dimension(nbpatienta),intent(inout)::uscore
00169           double precision,dimension(nbpatienta) :: reduce1
00170           double precision, dimension(2,npm,nbpatienta) :: reduce3
00171           integer, dimension(2,npm,nbpatienta) :: reduce4
00172           double precision :: reduce0
00173 
00174           call MPI_BARRIER (MPI_COMM_WORLD, mpierr)
00175           reduce1=0.0D0
00176           if (nbprocs .gt. 1) then
00177 
00178 
00179               call MPI_ALLREDUCE (scorePRECISION, reduce3,           &
00180                                   2*npm*nbpatienta,           &
00181                                   MPI_DOUBLE_PRECISION, MPI_SUM,           &
00182                                   MPI_COMM_WORLD, mpierr)
00183              scorePRECISION(:,:,1:nbpatienta) = reduce3
00184              call MPIErrorCatch(mpierr)
00185 
00186 
00187               call MPI_ALLREDUCE (scoreERROR, reduce4,           &
00188                                   2*npm*nbpatienta,           &
00189                                   MPI_INTEGER, MPI_SUM,           &
00190                                   MPI_COMM_WORLD, mpierr)
00191              scoreERROR(:,:,1:nbpatienta) = reduce4
00192              call MPIErrorCatch(mpierr)
00193 
00194                call MPI_ALLREDUCE (uscore(1:nbpatient), &
00195                reduce1(1:nbpatient), nbpatient, &
00196                MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, mpierr)
00197                uscore(1:nbpatient) = reduce1(1:nbpatient)
00198                call MPIErrorCatch(mpierr)
00199 
00200           end if
00201           return
00202       end subroutine synchroCALCULSCORES
00203 
00204   !---------------------------------------------------------------------------------
00207      subroutine MPIattente
00208         implicit none
00209         CALL MPI_BARRIER (MPI_COMM_WORLD, mpierr)
00210      end subroutine MPIattente
00211 
00212   !---------------------------------------------------------------------------------
00215      subroutine MPIErrorCatch(error)
00216         implicit none
00217         integer, intent(in) :: error 
00218         if(error.NE.0) then
00219              if(numproc.EQ.0) write(0,*) "***WARNING ***WARNING ***WARNING *** WARNING ***"
00220              if(numproc.EQ.0) write(0,*) "PROGRAM STOPPED BECAUSE MPI ERROR ON SOME NODES"
00221              if(numproc.EQ.0) write(0,*) "***WARNING ***WARNING ***WARNING *** WARNING ***"
00222              if(numproc.EQ.0) write(999,*) "***WARNING ***WARNING ***WARNING *** WARNING ***"
00223              if(numproc.EQ.0) write(999,*) "PROGRAM STOPPED BECAUSE MPI ERROR ON SOME NODES"
00224              if(numproc.EQ.0) write(999,*) "***WARNING ***WARNING ***WARNING *** WARNING ***"
00225              stop
00226         end if
00227      end subroutine MPIErrorCatch
00228 
00229 end module mpimod