/*============================================================================
*
* Code_Saturne version 1.3
* ------------------------
*
*
* This file is part of the Code_Saturne Kernel, element of the
* Code_Saturne CFD tool.
*
* Copyright (C) 1998-2007 EDF S.A., France
*
* contact: saturne-support@edf.fr
*
* The Code_Saturne Kernel is free software; you can redistribute it
* and/or modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2 of
* the License, or (at your option) any later version.
*
* The Code_Saturne Kernel is distributed in the hope that it will be
* useful, but WITHOUT ANY WARRANTY; without even the implied warranty
* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with the Code_Saturne Kernel; if not, write to the
* Free Software Foundation, Inc.,
* 51 Franklin St, Fifth Floor,
* Boston, MA 02110-1301 USA
*
*============================================================================*/
/*============================================================================
* Interfaces Fortran pour la parallélisation du code
*============================================================================*/
/* includes système */
#include <assert.h>
#include <stdarg.h>
#include <string.h>
/* Includes BFT et FVM */
#include <bft_mem.h>
/* Includes librairie */
#include "cs_base.h"
#include "cs_comm.h"
#include "cs_maillage.h"
#include "cs_parallel.h"
#ifdef __cplusplus
extern "C" {
#endif /* __cplusplus */
#define CS_PARALLEL_DEBUG_COMPTE 0
#define CS_PARALLEL_TAILLE_TABLEAU 500
/*============================================================================
* Variables statiques locales
*============================================================================*/
/* Compteur du nombre d'appel par sous-programme */
#if CS_PARALLEL_DEBUG_COMPTE
static cs_int_t cs_loc_num_appel_tot = 0;
static cs_int_t cs_loc_num_appel_pargve = 0;
static cs_int_t cs_loc_num_appel_parcom = 0;
static cs_int_t cs_loc_num_appel_parcve = 0;
static cs_int_t cs_loc_num_appel_parcmx = 0;
static cs_int_t cs_loc_num_appel_parcpt = 0;
static cs_int_t cs_loc_num_appel_parsom = 0;
static cs_int_t cs_loc_num_appel_parmax = 0;
static cs_int_t cs_loc_num_appel_parmin = 0;
static cs_int_t cs_loc_num_appel_parmxl = 0;
static cs_int_t cs_loc_num_appel_parmnl = 0;
static cs_int_t cs_loc_num_appel_parism = 0;
static cs_int_t cs_loc_num_appel_parimx = 0;
static cs_int_t cs_loc_num_appel_parimn = 0;
static cs_int_t cs_loc_num_appel_parrsm = 0;
static cs_int_t cs_loc_num_appel_parrmx = 0;
static cs_int_t cs_loc_num_appel_parrmn = 0;
static cs_int_t cs_loc_num_appel_parbci = 0;
static cs_int_t cs_loc_num_appel_parbcr = 0;
static cs_int_t cs_loc_num_appel_paragv = 0;
static cs_int_t cs_loc_num_appel_parfpt = 0;
static cs_int_t cs_loc_num_appel_parhis = 0;
static cs_int_t cs_loc_num_appel_parcel = 0;
static cs_int_t cs_loc_num_appel_interface_sr = 0;
#endif
/*============================================================================
* Prototypes de fonctions privées
*============================================================================*/
/*============================================================================
* Fonctions publiques pour API Fortran
*============================================================================*/
/*----------------------------------------------------------------------------
* Initialisations après lecture du maillage en cas de parallélisme
*
* Interface Fortran :
*
* SUBROUTINE PARGEO
* *****************
*
* INTEGER NCELGB : <- : Nombre de cellules global
* INTEGER NFACGB : <- : Nombre de faces internes global
* INTEGER NFBRGB : <- : Nombre de faces internes global
* INTEGER NSOMGB : <- : Nombre de sommets global
*----------------------------------------------------------------------------*/
void CS_PROCF (pargeo, PARGEO)
(
cs_int_t *ncelgb, /* <- Nombre de cellules global */
cs_int_t *nfacgb, /* <- Nombre de faces internes global */
cs_int_t *nfbrgb, /* <- Nombre de faces internes global */
cs_int_t *nsomgb /* <- Nombre de sommets global */
)
{
#if defined(_CS_HAVE_MPI)
*ncelgb = cs_glob_maillage->nbr_cel_glob;
*nfacgb = cs_glob_maillage->nbr_fac_glob;
*nfbrgb = cs_glob_maillage->nbr_fbr_glob;
*nsomgb = cs_glob_maillage->nbr_som_glob;
#endif
}
/*----------------------------------------------------------------------------
* Mise à jour du voisinage étendu des coordonnées du centre des cellules
* dans le voisinage étendu s'il est traité séparément du reste du halo
*
* Le rôle de cette fonction consiste à recopier les valeurs sur les
* cellules principales en frontière parallèle d'autres domaines
* (indices entre 1 et ncel) vers les cellules halo du domaine en
* cours et a les placer dans la structure maillage
*
* Interface Fortran :
*
* SUBROUTINE PARGVE (NDIM, XYZCEN)
* *****************
*
* INTEGER NDIM : --> : dimension de l'espace
* DOUBLE PRECISION XYZCEN(3,NCELET) : --> : coordonnées du centre des cellules
*----------------------------------------------------------------------------*/
void CS_PROCF (pargve, PARGVE)
(
const cs_int_t * const ndim ,/* --> dimension de l'espace */
const cs_real_t * const xyzcen /* --> coordonnées du centre des cellules */
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t dbloc ;
cs_int_t lbloc ;
cs_int_t ind ;
cs_int_t ind_dom ;
cs_int_t cpt_request ;
cs_real_t *buf ;
cs_real_t *coord_assembl ;
cs_maillage_t * maillage = cs_glob_maillage;
cs_maillage_tmp_t * maillage_tmp = cs_glob_maillage_tmp;
/* Uniquement dans le cas d'un voisinage étendu traité séparément */
if(maillage->ind_type_voiset == CS_MAILLAGE_TYPE_VOISET_SEPARE) {
/* Allocation de la mémoire */
/* pour recevoir les coordonnées du centre des cellules
uniquement si nbr_cel_fac_par_voiset > 0 sur le processeur local */
if( maillage->nbr_cel_fac_par_voiset > 0)
BFT_MALLOC(maillage->coord_cel_avec_voiset,
(*ndim)*(maillage->nbr_cel+
maillage->nbr_cel_fac_par+
maillage->nbr_cel_fac_par_voiset),
cs_real_t);
else
maillage->coord_cel_avec_voiset = NULL ;
/* pour envoyer les coordonnées du centre des cellules */
BFT_MALLOC(coord_assembl,
(*ndim)*(maillage_tmp->pos_dom_var_assembl_voiset
[maillage_tmp->nbr_dom_var_assembl_voiset]-1),
cs_real_t);
/*
Émission et réception de messages des autres domaines
(avec des communications non bloquantes)
*/
cpt_request = 0 ;
/* Réception */
for (ind_dom = 0 ;
ind_dom < maillage->nbr_dom_fac_par_voiset ; ind_dom++) {
/* Test sur le numéro de maillage utile en périodicité */
/* On le laisse par cohérence avec parcom, mais on pourrait
s'en affranchir, car en périodicité, on ne fera rien de plus */
if (maillage->num_dom_fac_par_voiset[ind_dom]
!= maillage->num_dom) {
/* On réceptionne des voisins directement dans la structure maillage */
dbloc = maillage->pos_dom_fac_par_voiset[ind_dom] - 1;
lbloc = maillage->pos_dom_fac_par_voiset[ind_dom + 1]
- maillage->pos_dom_fac_par_voiset[ind_dom] ;
buf = maillage->coord_cel_avec_voiset +
(maillage->nbr_cel + maillage->nbr_cel_fac_par + dbloc)*(*ndim) ;
lbloc = lbloc*(*ndim) ;
MPI_Irecv (buf,
lbloc,
CS_MPI_REAL,
maillage->num_dom_fac_par_voiset[ind_dom] - 1,
maillage->num_dom_fac_par_voiset[ind_dom] - 1,
cs_glob_base_mpi_comm,
&(maillage_tmp->mpi_request[cpt_request++]));
}
}
/* Emission */
for (ind_dom = 0 ;
ind_dom < maillage_tmp->nbr_dom_var_assembl_voiset ; ind_dom++) {
/* Test sur le numéro de maillage utile en périodicité */
/* On le laisse par cohérence avec parcom, mais on pourrait
s'en affranchir, car en périodicité, on ne fera rien de plus */
if (maillage_tmp->num_dom_var_assembl_voiset[ind_dom]
!= maillage->num_dom) {
/* On envoie aux voisins, dans une variable d'assemblage */
dbloc = maillage_tmp->pos_dom_var_assembl_voiset[ind_dom] - 1 ;
lbloc
= maillage_tmp->pos_dom_var_assembl_voiset[ind_dom + 1]
- maillage_tmp->pos_dom_var_assembl_voiset[ind_dom] ;
for (ind = 0 ; ind < lbloc ; ind++) {
coord_assembl[(dbloc + ind)*(*ndim) ]
= xyzcen
[(maillage_tmp->num_cel_loc_par_voiset[dbloc + ind] - 1)*(*ndim) ];
coord_assembl[(dbloc + ind)*(*ndim) + 1]
= xyzcen
[(maillage_tmp->num_cel_loc_par_voiset[dbloc + ind] - 1)*(*ndim)+1];
coord_assembl[(dbloc + ind)*(*ndim) + 2]
= xyzcen
[(maillage_tmp->num_cel_loc_par_voiset[dbloc + ind] - 1)*(*ndim)+2];
}
buf = coord_assembl + dbloc*(*ndim) ;
lbloc = lbloc*(*ndim) ;
MPI_Isend (buf,
lbloc,
CS_MPI_REAL,
maillage_tmp->num_dom_var_assembl_voiset[ind_dom] - 1,
maillage->num_dom - 1,
cs_glob_base_mpi_comm,
&(maillage_tmp->mpi_request[cpt_request++]));
}
}
/* On synchronise apres que tout le monde ait recu tous les messages */
MPI_Waitall (cpt_request,
maillage_tmp->mpi_request,
maillage_tmp->mpi_status);
/* On libère la variable d'envoi */
BFT_FREE(coord_assembl) ;
/*
On recopie le début du tableau des coordonnées, uniquement si
on a alloué le tableau maillage->coord_cel_avec_voiset, ie si
maillage->nbr_cel_fac_par_voiset > 0
*/
if(maillage->nbr_cel_fac_par_voiset > 0)
for (ind = 0 ;
ind < (maillage->nbr_cel + maillage->nbr_cel_fac_par)*(*ndim) ;
ind++)
maillage->coord_cel_avec_voiset[ind] = xyzcen[ind] ;
}
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, pargve\n",
cs_glob_base_rang, cs_loc_num_appel_pargve++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Mise à jour d'un tableau sur les cellules en cas de parallélisme
*
* Le rôle de cette fonction consiste à recopier les valeurs sur les
* cellules principales en frontière parallèle d'autres domaines
* (indices entre 1 et ncel) vers les cellules halo du domaine en
* cours (indices ncel+1 à ncelet)
*
* Interface Fortran :
*
* SUBROUTINE PARCOM (VAR)
* *****************
*
* DOUBLE PRECISION VAR(NCELET) : <-> : variable sur les cellules, mise à
* jour de VAR(NCEL+1..NCELET) en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parcom, PARCOM)
(
cs_real_t var[] /* <-> variable définie sur les cellules
* (mise à jour sur les cellules halo) */
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t dbloc, lbloc;
cs_int_t ind, ind_dom;
cs_real_t *buf;
int cpt_request = 0;
cs_maillage_t * maillage = cs_glob_maillage;
cs_maillage_tmp_t * maillage_tmp = cs_glob_maillage_tmp;
/*
Émission et réception de messages des autres domaines
(avec des communications non bloquantes)
*/
/* Réception (à poster avant émission) */
/*-------------------------------------*/
for (ind_dom = 0 ; ind_dom < maillage->nbr_dom_fac_par ; ind_dom++) {
/* Test sur le numéro de maillage utile en périodicité */
if (maillage->num_dom_fac_par[ind_dom] != maillage->num_dom) {
/* On réceptionne des voisins directement dans le halo */
dbloc = maillage->pos_dom_fac_par[ind_dom] - 1;
lbloc = maillage->pos_dom_fac_par[ind_dom + 1]
- maillage->pos_dom_fac_par[ind_dom] ;
buf = var + maillage->nbr_cel + dbloc ;
MPI_Irecv (buf,
lbloc,
CS_MPI_REAL,
maillage->num_dom_fac_par[ind_dom] - 1,
maillage->num_dom_fac_par[ind_dom] - 1,
cs_glob_base_mpi_comm,
&(maillage_tmp->mpi_request[cpt_request++]));
}
}
/* On attend que tous les "receive" soient postés */
MPI_Barrier(cs_glob_base_mpi_comm);
for (ind_dom = 0 ; ind_dom < maillage_tmp->nbr_dom_var_assembl ; ind_dom++) {
/* Emission */
/*----------*/
/* Test sur le numéro de maillage utile en périodicité */
if (maillage_tmp->num_dom_var_assembl[ind_dom] != maillage->num_dom) {
/* On envoie aux voisins, dans une variable d'assemblage */
dbloc = maillage_tmp->pos_dom_var_assembl[ind_dom] - 1;
lbloc = maillage_tmp->pos_dom_var_assembl[ind_dom + 1]
- maillage_tmp->pos_dom_var_assembl[ind_dom] ;
for (ind = 0 ; ind < lbloc ; ind++)
maillage_tmp->var_assembl[dbloc + ind]
= var[maillage_tmp->num_cel_loc_par[dbloc + ind] - 1];
buf = maillage_tmp->var_assembl + dbloc ;
MPI_Isend (buf,
lbloc,
CS_MPI_REAL,
maillage_tmp->num_dom_var_assembl[ind_dom] - 1,
maillage->num_dom - 1,
cs_glob_base_mpi_comm,
&(maillage_tmp->mpi_request[cpt_request++]));
}
}
/* On synchronise apres que tout le monde ait recu tous les messages */
MPI_Waitall (cpt_request,
maillage_tmp->mpi_request,
maillage_tmp->mpi_status);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parcom\n",
cs_glob_base_rang, cs_loc_num_appel_parcom++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Mise à jour du voisinage étendu d'une variable au centre des cellules
* dans le voisinage étendu s'il est traité séparément du reste du halo
*
* Fonction calquée sur PARCOM
*
* Le rôle de cette fonction consiste à recopier les valeurs sur les
* cellules principales en frontière parallèle d'autres domaines
* (indices entre 1 et ncel) vers les cellules halo du domaine en
* cours.
*
*----------------------------------------------------------------------------*/
void cs_parallel_parcve
(
const cs_real_t * const var ,/* --> variable au centre des cellules */
cs_real_t * var_voiset /* <-> variable au centre des cellules
dans le voisinage étendu */
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t dbloc, lbloc;
cs_int_t ind, ind_dom;
cs_real_t *buf;
cs_int_t cpt_request ;
cs_maillage_t * maillage = cs_glob_maillage;
cs_maillage_tmp_t * maillage_tmp = cs_glob_maillage_tmp;
/* Uniquement dans le cas d'un voisinage étendu traité séparément */
/*
Émission et réception de messages des autres domaines
(avec des communications non bloquantes)
*/
cpt_request = 0 ;
/* Réception */
for (ind_dom = 0 ; ind_dom < maillage->nbr_dom_fac_par_voiset ; ind_dom++) {
/* Test sur le numéro de maillage utile en périodicité */
/* On le laisse par cohérence avec parcom, mais on pourrait
s'en affranchir, car en périodicité, on ne fera rien de plus */
if (maillage->num_dom_fac_par_voiset[ind_dom] != maillage->num_dom) {
/* On réceptionne des voisins directement dans le halo */
dbloc = maillage->pos_dom_fac_par_voiset[ind_dom] - 1;
lbloc = maillage->pos_dom_fac_par_voiset[ind_dom + 1]
- maillage->pos_dom_fac_par_voiset[ind_dom] ;
buf = var_voiset + dbloc ;
MPI_Irecv (buf,
lbloc,
CS_MPI_REAL,
maillage->num_dom_fac_par_voiset[ind_dom] - 1,
maillage->num_dom_fac_par_voiset[ind_dom] - 1,
cs_glob_base_mpi_comm,
&(maillage_tmp->mpi_request[cpt_request++]));
}
}
/* Émission */
for (ind_dom = 0 ;
ind_dom < maillage_tmp->nbr_dom_var_assembl_voiset ; ind_dom++) {
/* Test sur le numéro de maillage utile en périodicité */
/* On le laisse par cohérence avec parcom, mais on pourrait
s'en affranchir, car en périodicité, on ne fera rien de plus */
if (maillage_tmp->num_dom_var_assembl_voiset[ind_dom]
!= maillage->num_dom) {
/* On envoie aux voisins, dans une variable d'assemblage */
dbloc = maillage_tmp->pos_dom_var_assembl_voiset[ind_dom] - 1 ;
lbloc
= maillage_tmp->pos_dom_var_assembl_voiset[ind_dom + 1]
- maillage_tmp->pos_dom_var_assembl_voiset[ind_dom] ;
for (ind = 0 ; ind < lbloc ; ind++)
maillage_tmp->var_assembl_voiset[dbloc + ind]
= var[maillage_tmp->num_cel_loc_par_voiset[dbloc + ind] - 1];
buf = maillage_tmp->var_assembl_voiset + dbloc ;
MPI_Isend (buf,
lbloc,
CS_MPI_REAL,
maillage_tmp->num_dom_var_assembl_voiset[ind_dom] - 1,
maillage->num_dom - 1,
cs_glob_base_mpi_comm,
&(maillage_tmp->mpi_request[cpt_request++]));
}
}
/* On synchronise après que tout le monde ait recu tous les messages */
MPI_Waitall (cpt_request,
maillage_tmp->mpi_request,
maillage_tmp->mpi_status);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parcve\n",
cs_glob_base_rang, cs_loc_num_appel_parcve++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Interface FORTRAN pour les echanges sur le voisinage étendu lorsqu'il est
* traité séparément du halo classique. Le tableau traité est supposé
* correctement dimensionné (ncelet + nombre de cellules halo étendu).
*
* Appelée en parallèle uniquement.
*
* Interface Fortran :
*
* SUBROUTINE PARCVE
* *****************
*
* & ( PVAR )
*
*----------------------------------------------------------------------------*/
void CS_PROCF (parcve, PARCVE)
(
cs_real_t pvar[] /* <-> tab. echangé */
CS_ARGF_SUPP_CHAINE /* (arguments 'longueur' éventuels,
Fortran, inutilisés lors de
l'appel mais placés par de
nombreux compilateurs) */
)
{
cs_real_t *pvar_voiset ;
cs_maillage_t *maillage = cs_glob_maillage;
/* Utile uniquement pour le voisinage étendu séparé */
if(maillage->ind_type_voiset == CS_MAILLAGE_TYPE_VOISET_SEPARE) {
/* Identification des pointeurs sur le voisinage étendu séparé */
if(maillage->nbr_cel_fac_par_voiset > 0) {
pvar_voiset = pvar + (maillage->nbr_cel + maillage->nbr_cel_fac_par) ;
}
else {
pvar_voiset = NULL ;
}
/* Echanges parallèles
Attention, un processeur peut n'avoir rien à recevoir
(maillage->nbr_cel_fac_par_voiset = 0), mais avoir cependant
des éléments à envoyer : on doit donc entrer dans parcve
pour tous les processeurs lorsque l'on est en parallèle */
if(maillage->nbr_dom > 1)
cs_parallel_parcve(pvar, pvar_voiset) ;
}
}
/*----------------------------------------------------------------------------
* Maximum d'un compteur entier sur plusieurs domaines en cas de parallélisme
*
* Le rôle de cette fonction consiste à mettre l'indicateur ind à la valeur
* maximale obtenue sur les différents domaines de calcul
*
* Interface Fortran :
*
* SUBROUTINE PARCMX (IND)
* *****************
*
* INTEGER IND : <-> : indicateur local en entrée,
* maximum en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parcmx, PARCMX)
(
cs_int_t *ind /* <-> indicateur */
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t maxglob;
assert (sizeof (int) == sizeof (cs_int_t));
MPI_Allreduce (ind, &maxglob, 1, CS_MPI_INT, MPI_MAX,
cs_glob_base_mpi_comm);
*ind = maxglob;
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parcmx\n",
cs_glob_base_rang, cs_loc_num_appel_parcmx++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Somme d'un compteur entier sur plusieurs domaines en cas de parallélisme
*
* Le rôle de cette fonction consiste à ajouter au compteur cpt les
* valeurs correspondantes sur les autre domaines de calcul
*
* Interface Fortran :
*
* SUBROUTINE PARCPT (CPT)
* *****************
*
* INTEGER CPT : <-> : compteur à sommer en entrée,
* somme en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parcpt, PARCPT)
(
cs_int_t *cpt /* <-> compteur à sommer */
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t total;
assert (sizeof (int) == sizeof (cs_int_t));
MPI_Allreduce (cpt, &total, 1, CS_MPI_INT, MPI_SUM,
cs_glob_base_mpi_comm);
*cpt = total;
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parcpt\n",
cs_glob_base_rang, cs_loc_num_appel_parcpt++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Somme d'un réel sur plusieurs domaines en cas de parallélisme
*
* Le rôle de cette fonction consiste à ajouter au réel var les
* valeurs correspondantes sur les autre domaines de calcul
*
* Interface Fortran :
*
* SUBROUTINE PARSOM (VAR)
* *****************
*
* DOUBLE PRECISION VAR : <-> : valeur à sommer en entrée,
* somme en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parsom, PARSOM)
(
cs_real_t *var /* <-> variable à sommer */
)
{
#if defined(_CS_HAVE_MPI)
cs_real_t somme;
assert (sizeof (double) == sizeof (cs_real_t));
MPI_Allreduce (var, &somme, 1, CS_MPI_REAL, MPI_SUM,
cs_glob_base_mpi_comm);
*var = somme;
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parsom\n",
cs_glob_base_rang, cs_loc_num_appel_parsom++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Maximum d'un réel sur plusieurs domaines en cas de parallélisme
*
* Interface Fortran :
*
* SUBROUTINE PARMAX (VAR)
* *****************
*
* DOUBLE PRECISION VAR : <-> : maximum local en entrée,
* maximum global en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parmax, PARMAX)
(
cs_real_t *var
)
{
#if defined(_CS_HAVE_MPI)
cs_real_t varmax;
assert (sizeof (double) == sizeof (cs_real_t));
MPI_Allreduce (var, &varmax, 1, CS_MPI_REAL, MPI_MAX,
cs_glob_base_mpi_comm);
*var = varmax;
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parmax\n",
cs_glob_base_rang, cs_loc_num_appel_parmax++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Minimum d'un réel sur plusieurs domaines en cas de parallélisme
*
* Interface Fortran :
*
* SUBROUTINE PARMIN (VAR)
* *****************
*
* DOUBLE PRECISION VAR : <-> : minimum local en entrée,
* minimum global en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parmin, PARMIN)
(
cs_real_t *var
)
{
#if defined(_CS_HAVE_MPI)
cs_real_t varmin;
assert (sizeof (double) == sizeof (cs_real_t));
MPI_Allreduce (var, &varmin, 1, CS_MPI_REAL, MPI_MIN,
cs_glob_base_mpi_comm);
*var = varmin;
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parmin\n",
cs_glob_base_rang, cs_loc_num_appel_parmin++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Maximum d'un réel et valeurs associées sur plusieurs domaines
* en cas de parallélisme
*
* Interface Fortran :
*
* SUBROUTINE PARMXL (NBR, VAR, XYZVAR)
* *****************
*
* INTEGER NBR : -> : nombre de valeurs associees
* DOUBLE PRECISION VAR : <-> : maximum local en entrée,
* maximum global en sortie
* DOUBLE PRECISION XYZVAR(NBR) : <-> : val. associees au max loc. en entrée,
* val. associees au max. glob. en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parmxl, PARMXL)
(
cs_int_t *nbr,
cs_real_t *var,
cs_real_t xyzvar[]
)
{
#if defined(_CS_HAVE_MPI)
cs_mpi_real_int_t val_in, val_max;
assert (sizeof (double) == sizeof (cs_real_t));
val_in.val = *var;
val_in.rang = cs_glob_base_rang;
MPI_Allreduce (&val_in, &val_max, 1, CS_MPI_REAL_INT, MPI_MAXLOC,
cs_glob_base_mpi_comm);
*var = val_max.val;
MPI_Bcast (xyzvar, *nbr, CS_MPI_REAL, val_max.rang, cs_glob_base_mpi_comm);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parmxl\n",
cs_glob_base_rang, cs_loc_num_appel_parmxl++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Minimum d'un réel et valeurs associées sur plusieurs domaines
* en cas de parallélisme
*
* Interface Fortran :
*
* SUBROUTINE PARMNL (NBR, VAR, XYZVAR)
* *****************
*
* INTEGER NBR : -> : nombre de valeurs associees
* DOUBLE PRECISION VAR : <-> : minimum local en entrée,
* minimum global en sortie
* DOUBLE PRECISION XYZVAR(NBR) : <-> : valeurs associées min local en entrée,
* valeurs associées min global en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parmnl, PARMNL)
(
cs_int_t *nbr,
cs_real_t *var,
cs_real_t xyzvar[]
)
{
#if defined(_CS_HAVE_MPI)
cs_mpi_real_int_t val_in, val_min;
assert (sizeof (double) == sizeof (cs_real_t));
val_in.val = *var;
val_in.rang = cs_glob_base_rang;
MPI_Allreduce (&val_in, &val_min, 1, CS_MPI_REAL_INT, MPI_MINLOC,
cs_glob_base_mpi_comm);
*var = val_min.val ;
MPI_Bcast (xyzvar, *nbr, CS_MPI_REAL, val_min.rang, cs_glob_base_mpi_comm);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parmnl\n",
cs_glob_base_rang, cs_loc_num_appel_parmnl++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Somme d'un tableau entier sur plusieurs domaines en cas de parallélisme
*
* Le rôle de cette fonction consiste à mettre le tableau itab a la valeur
* somme des valeurs correspondantes sur les autre domaines de calcul
* (terme par terme)
*
* Interface Fortran :
*
* SUBROUTINE PARISM (NBR,ITAB)
* *****************
*
* INTEGER NBR : -> : nombre de valeurs à envoyer/recevoir
* INTEGER ITAB(*) : <-> : tableau local en entrée,
* somme en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parism, PARISM)
(
cs_int_t *nbr, /* <-> dimension */
cs_int_t itab[]
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t somtab_fixe[CS_PARALLEL_TAILLE_TABLEAU] ;
cs_int_t ind ;
cs_int_t *somtab ;
if (CS_PARALLEL_TAILLE_TABLEAU < *nbr) {
BFT_MALLOC(somtab, *nbr, cs_int_t);
assert (sizeof (int) == sizeof (cs_int_t));
MPI_Allreduce (itab, somtab, *nbr, CS_MPI_INT, MPI_SUM,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
itab[ind] = somtab[ind] ;
}
BFT_FREE(somtab) ;
}
else {
assert (sizeof (int) == sizeof (cs_int_t));
MPI_Allreduce (itab, somtab_fixe, *nbr, CS_MPI_INT, MPI_SUM,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
itab[ind] = somtab_fixe[ind] ;
}
}
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parism\n",
cs_glob_base_rang, cs_loc_num_appel_parism++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Maximum d'un tableau entier sur plusieurs domaines en cas de parallélisme
*
* Le rôle de cette fonction consiste à mettre le tableau itab à la valeur
* maximale obtenue sur les différents domaines de calcul
*
* Interface Fortran :
*
* SUBROUTINE PARIMX (NBR,ITAB)
* *****************
*
* INTEGER NBR : -> : nombre de valeurs à envoyer/recevoir
* INTEGER ITAB(*) : <-> : tableau local en entrée,
* maximum en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parimx, PARIMX)
(
cs_int_t *nbr, /* <-> dimension */
cs_int_t itab[]
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t maxglobtab_fixe[CS_PARALLEL_TAILLE_TABLEAU] ;
cs_int_t ind ;
cs_int_t *maxglobtab ;
if (CS_PARALLEL_TAILLE_TABLEAU < *nbr) {
BFT_MALLOC(maxglobtab, *nbr, cs_int_t);
assert (sizeof (int) == sizeof (cs_int_t));
MPI_Allreduce (itab, maxglobtab, *nbr, CS_MPI_INT, MPI_MAX,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
itab[ind] = maxglobtab[ind] ;
}
BFT_FREE(maxglobtab) ;
}
else {
assert (sizeof (int) == sizeof (cs_int_t));
MPI_Allreduce (itab, maxglobtab_fixe, *nbr, CS_MPI_INT, MPI_MAX,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
itab[ind] = maxglobtab_fixe[ind] ;
}
}
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parimx\n",
cs_glob_base_rang, cs_loc_num_appel_parimx++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Minimum d'un tableau entier sur plusieurs domaines en cas de parallélisme
*
* Le rôle de cette fonction consiste à mettre le tableau itab à la valeur
* minimale obtenue sur les différents domaines de calcul
*
* Interface Fortran :
*
* SUBROUTINE PARIMN (NBR,ITAB)
* *****************
*
* INTEGER NBR : -> : nombre de valeurs à envoyer/recevoir
* INTEGER ITAB(*) : <-> : tableau local en entrée,
* minimum en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parimn, PARIMN)
(
cs_int_t *nbr, /* <-> dimension */
cs_int_t itab[]
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t minglobtab_fixe[CS_PARALLEL_TAILLE_TABLEAU] ;
cs_int_t ind ;
cs_int_t *minglobtab ;
if (CS_PARALLEL_TAILLE_TABLEAU < *nbr) {
BFT_MALLOC(minglobtab, *nbr, cs_int_t);
assert (sizeof (int) == sizeof (cs_int_t));
MPI_Allreduce (itab, minglobtab, *nbr, CS_MPI_INT, MPI_MIN,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
itab[ind] = minglobtab[ind] ;
}
BFT_FREE(minglobtab) ;
}
else {
assert (sizeof (int) == sizeof (cs_int_t));
MPI_Allreduce (itab, minglobtab_fixe, *nbr, CS_MPI_INT, MPI_MIN,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
itab[ind] = minglobtab_fixe[ind] ;
}
}
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parimn\n",
cs_glob_base_rang, cs_loc_num_appel_parimn++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Somme d'un tableau reel sur plusieurs domaines en cas de parallélisme
*
* Le rôle de cette fonction consiste à mettre le tableau rtab a la valeur
* somme des valeurs correspondantes sur les autre domaines de calcul
* (terme par terme)
*
* Interface Fortran :
*
* SUBROUTINE PARRSM (NBR,RTAB)
* *****************
*
* INTEGER NBR : -> : nombre de valeurs à envoyer/recevoir
* DOUBLE PRECISION RTAB(*) : <-> : tableau local en entrée,
* somme en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parrsm, PARRSM)
(
cs_int_t *nbr, /* <-> dimension */
cs_real_t rtab[]
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t ind ;
cs_real_t somtab_fixe[CS_PARALLEL_TAILLE_TABLEAU] ;
cs_real_t *somtab ;
if (CS_PARALLEL_TAILLE_TABLEAU < *nbr) {
BFT_MALLOC(somtab, *nbr, cs_real_t);
assert (sizeof (double) == sizeof (cs_real_t));
MPI_Allreduce (rtab, somtab, *nbr, CS_MPI_REAL, MPI_SUM,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
rtab[ind] = somtab[ind] ;
}
BFT_FREE(somtab) ;
}
else {
assert (sizeof (double) == sizeof (cs_real_t));
MPI_Allreduce (rtab, somtab_fixe, *nbr, CS_MPI_REAL, MPI_SUM,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
rtab[ind] = somtab_fixe[ind] ;
}
}
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parrsm\n",
cs_glob_base_rang, cs_loc_num_appel_parrsm++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Maximum d'un tableau reel sur plusieurs domaines en cas de parallélisme
*
* Le rôle de cette fonction consiste à mettre le tableau rtab à la valeur
* maximale obtenue sur les différents domaines de calcul
*
* Interface Fortran :
*
* SUBROUTINE PARRMX (NBR,RTAB)
* *****************
*
* INTEGER NBR : -> : nombre de valeurs à envoyer/recevoir
* DOUBLE PRECISION RTAB(*) : <-> : tableau local en entrée,
* maximum en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parrmx, PARRMX)
(
cs_int_t *nbr, /* <-> dimension */
cs_real_t rtab[]
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t ind ;
cs_real_t maxglobtab_fixe[CS_PARALLEL_TAILLE_TABLEAU] ;
cs_real_t *maxglobtab ;
if (CS_PARALLEL_TAILLE_TABLEAU < *nbr) {
BFT_MALLOC(maxglobtab, *nbr, cs_real_t);
assert (sizeof (double) == sizeof (cs_real_t));
MPI_Allreduce (rtab, maxglobtab, *nbr, CS_MPI_REAL, MPI_MAX,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
rtab[ind] = maxglobtab[ind] ;
}
BFT_FREE(maxglobtab) ;
}
else {
assert (sizeof (double) == sizeof (cs_real_t));
MPI_Allreduce (rtab, maxglobtab_fixe, *nbr, CS_MPI_REAL, MPI_MAX,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
rtab[ind] = maxglobtab_fixe[ind] ;
}
}
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parrmx\n",
cs_glob_base_rang, cs_loc_num_appel_parrmx++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Minimum d'un tableau reel sur plusieurs domaines en cas de parallélisme
*
* Le rôle de cette fonction consiste à mettre le tableau rtab à la valeur
* minimale obtenue sur les différents domaines de calcul
*
* Interface Fortran :
*
* SUBROUTINE PARRMN (NBR,RTAB)
* *****************
*
* INTEGER NBR : -> : nombre de valeurs à envoyer/recevoir
* INTEGER RTAB(*) : <-> : tableau local en entrée,
* minimum en sortie
*----------------------------------------------------------------------------*/
void CS_PROCF (parrmn, PARRMN)
(
cs_int_t *nbr, /* <-> dimension */
cs_real_t rtab[]
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t ind ;
cs_real_t minglobtab_fixe[CS_PARALLEL_TAILLE_TABLEAU] ;
cs_real_t *minglobtab ;
if (CS_PARALLEL_TAILLE_TABLEAU < *nbr) {
BFT_MALLOC(minglobtab, *nbr, cs_real_t);
assert (sizeof (double) == sizeof (cs_real_t));
MPI_Allreduce (rtab, minglobtab, *nbr, CS_MPI_REAL, MPI_MIN,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
rtab[ind] = minglobtab[ind] ;
}
BFT_FREE(minglobtab) ;
}
else {
assert (sizeof (double) == sizeof (cs_real_t));
MPI_Allreduce (rtab, minglobtab_fixe, *nbr, CS_MPI_REAL, MPI_MIN,
cs_glob_base_mpi_comm);
for (ind = 0 ; ind < *nbr ; ind++) {
rtab[ind] = minglobtab_fixe[ind] ;
}
}
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parrmn\n",
cs_glob_base_rang, cs_loc_num_appel_parrmn++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Envoi de valeurs entières d'un processus à ses voisins
* (encapsulation de MPI_Bcast())
*
* Interface Fortran :
*
* SUBROUTINE PARBCI (IRANGV, NBR, ITAB)
* *****************
*
* INTEGER IRANGV : -> : rang du processus associé aux valeurs
* à envoyer
* INTEGER NBR : -> : nombre de valeurs à envoyer/recevoir
* INTEGER ITAB(*) : <-> : valeurs entières
*----------------------------------------------------------------------------*/
void CS_PROCF (parbci, PARBCI)
(
cs_int_t *irangv,
cs_int_t *nbr,
cs_int_t itab[]
)
{
#if defined(_CS_HAVE_MPI)
MPI_Bcast (itab, *nbr, CS_MPI_INT, *irangv, cs_glob_base_mpi_comm);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parbci\n",
cs_glob_base_rang, cs_loc_num_appel_parbci++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Envoi de valeurs réelles d'un processus à ses voisins
* (encapsulation de MPI_Bcast())
*
* Interface Fortran :
*
* SUBROUTINE PARBCR (IRANGV, NBR, RTAB)
* *****************
*
* INTEGER IRANGV : -> : rang du processus associé aux valeurs
* à envoyer
* INTEGER NBR : -> : nombre de valeurs à envoyer/recevoir
* DOUBLE PRECISION RTAB(*) : <-> : valeurs réelles
*----------------------------------------------------------------------------*/
void CS_PROCF (parbcr, PARBCR)
(
cs_int_t *irangv,
cs_int_t *nbr,
cs_real_t rtab[]
)
{
#if defined(_CS_HAVE_MPI)
MPI_Bcast (rtab, *nbr, CS_MPI_REAL, *irangv, cs_glob_base_mpi_comm);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parbcr\n",
cs_glob_base_rang, cs_loc_num_appel_parbcr++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Méthode "AllGather" pour récupérer les données sur tous les processeurs
* dans le cas où le nombre de variables locales est différent suivant
* les domaines
*
* Interface Fortran :
*
* SUBROUTINE PARAGV (NVAR, NVARGB, VAR, VARGB)
* *****************
*
* INTEGER NVAR : -> : nombre de variables locales
* INTEGER NVARGB : -> : nombre de variables globales
* DOUBLE PRECISION VAR(*) : -> : variables locales
* DOUBLE PRECISION VARGB(*) : <- : variables globales
*----------------------------------------------------------------------------*/
void CS_PROCF (paragv, PARAGV)
(
cs_int_t *nvar,
cs_int_t *nvargb,
cs_real_t var[],
cs_real_t *vargb
)
{
#if defined(_CS_HAVE_MPI)
cs_int_t i;
cs_int_t *rcount;
cs_int_t *disps;
assert (sizeof (double) == sizeof (cs_real_t));
BFT_MALLOC(rcount, cs_glob_maillage->nbr_dom, cs_int_t);
BFT_MALLOC(disps, cs_glob_maillage->nbr_dom, cs_int_t);
MPI_Allgather (nvar, 1, CS_MPI_INT, rcount, 1, CS_MPI_INT,
cs_glob_base_mpi_comm);
disps[0] = 0;
for (i = 1; i < cs_glob_maillage->nbr_dom; i++)
disps[i] = disps[i-1] + rcount[i-1];
assert(*nvargb == ( disps[cs_glob_maillage->nbr_dom-1]
+ rcount[cs_glob_maillage->nbr_dom-1]));
MPI_Allgatherv (var, *nvar, CS_MPI_REAL, vargb, rcount, disps, CS_MPI_REAL,
cs_glob_base_mpi_comm);
BFT_FREE(rcount);
BFT_FREE(disps);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, paragv\n",
cs_glob_base_rang, cs_loc_num_appel_paragv++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Recherche du point minimisant une distance donnée et du rang associé au
* processus contenant ce point (pour localiser un point parmi plusieurs
* domaines)
*
* Interface Fortran :
*
* SUBROUTINE PARFPT (NODE, NDRANG, DIS2MN)
* *****************
*
* INTEGER NODE : <-> : numéro local du point le plus proche
* du point recherché
* INTEGER NDRANG : <- : rang du processus pour lequel la
* distance est la plus faible
* DOUBLE PRECISION DIS2MN : -> : distance au carré du point en entrée
* au point recherché
*----------------------------------------------------------------------------*/
void CS_PROCF (parfpt, PARFPT)
(
cs_int_t *node,
cs_int_t *ndrang,
cs_real_t *dis2mn
)
{
#if defined(_CS_HAVE_MPI)
cs_mpi_real_int_t val_in, val_min;
assert (sizeof (double) == sizeof (cs_real_t));
val_in.val = *dis2mn;
val_in.rang = cs_glob_base_rang;
MPI_Allreduce (&val_in, &val_min, 1, CS_MPI_REAL_INT, MPI_MINLOC,
cs_glob_base_mpi_comm);
*ndrang = cs_glob_base_rang;
MPI_Bcast (node, 1, CS_MPI_INT, val_min.rang, cs_glob_base_mpi_comm);
MPI_Bcast (ndrang, 1, CS_MPI_INT, val_min.rang, cs_glob_base_mpi_comm);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parfpt\n",
cs_glob_base_rang, cs_loc_num_appel_parfpt++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Renvoi d'une valeur associée à une sonde
*
* Interface Fortran :
*
* SUBROUTINE PARHIS (NODE, NDRANG, VAR, VARCAP)
* *****************
*
* INTEGER NODE : -> : numéro local de l'élément associé
* à la sonde
* INTEGER NDRANG : -> : rang du processus associé à la sonde
* distance est la plus faible
* DOUBLE PRECISION VAR(*) : -> : variable discrétisée
* DOUBLE PRECISION VARCAP : <- : valeur de la variable au point associé
* à la sonde
*----------------------------------------------------------------------------*/
void CS_PROCF (parhis, PARHIS)
(
cs_int_t *node,
cs_int_t *ndrang,
cs_real_t var[],
cs_real_t *varcap
)
{
#if defined(_CS_HAVE_MPI)
assert (sizeof (double) == sizeof (cs_real_t));
if (*ndrang == cs_glob_base_rang)
*varcap = var[*node - 1];
else
*varcap = 0.0;
MPI_Bcast (varcap, 1, CS_MPI_REAL, *ndrang, cs_glob_base_mpi_comm);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parhis\n",
cs_glob_base_rang, cs_loc_num_appel_parhis++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Numéro de cellule global associé à un numéro de cellule local
* (envoi a tous les processeurs)
*
* Interface Fortran :
*
* SUBROUTINE PARCEL (NUMLOC,INDDOM,NUMGLO)
* *****************
*
* INTEGER NUMLOC : -> : numéro de cellule local
* INTEGER INDDOM : -> : rang du domaine associé (0 à N-1)
* INTEGER NUMGLO : <- : numéro de cellule global
*----------------------------------------------------------------------------*/
void CS_PROCF (parcel, PARCEL)
(
cs_int_t *numloc,
cs_int_t *inddom,
cs_int_t *numglo
)
{
#if defined(_CS_HAVE_MPI)
assert (sizeof (double) == sizeof (cs_real_t));
if (*inddom == cs_glob_base_rang)
*numglo = cs_glob_maillage->num_cel[*numloc - 1];
else
*numglo = 0;
MPI_Bcast (numglo, 1, CS_MPI_INT, *inddom, cs_glob_base_mpi_comm);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, parcel\n",
cs_glob_base_rang, cs_loc_num_appel_parcel++, cs_loc_num_appel_tot++);
#endif
}
/*----------------------------------------------------------------------------
* Numéro de cellule global associé à un numéro de cellule local
* du processeur courant, sans communication avec les autres
* Renvoie le numero de cellule en sequentiel
* Renvoie 0 si le numero local est superieur au nombre de cellules local
* Renvoie 0 si le rang du processeur courant n'est pas INDDOM
*
* Interface Fortran :
*
* SUBROUTINE PARCLG (NUMLOC,INDDOM,NUMGLO)
* *****************
*
* INTEGER NUMLOC : -> : numéro de cellule local
* INTEGER INDDOM : -> : rang du domaine associé (0 à N-1)
* INTEGER NUMGLO : <- : numéro de cellule global
*----------------------------------------------------------------------------*/
void CS_PROCF (parclg, PARCLG)
(
cs_int_t *numloc,
cs_int_t *inddom,
cs_int_t *numglo
)
{
if (*inddom < 0)
*numglo = *numloc;
else if ( (*inddom == cs_glob_base_rang) &&
(*numloc <= cs_glob_maillage->nbr_cel) )
*numglo = cs_glob_maillage->num_cel[*numloc - 1];
else
*numglo = 0;
}
/*----------------------------------------------------------------------------
* Numéro de face interne global associé à un numéro de face interne local
* du processeur courant, sans communication avec les autres
* Renvoie le numero de face interne en sequentiel
* Renvoie 0 si le numero local est superieur au nbre de faces internes local
* Renvoie 0 si le rang du processeur courant n'est pas INDDOM
*
* Interface Fortran :
*
* SUBROUTINE PARFIG (NUMLOC,INDDOM,NUMGLO)
* *****************
*
* INTEGER NUMLOC : -> : numéro de face interne local
* INTEGER INDDOM : -> : rang du domaine associé (0 à N-1)
* INTEGER NUMGLO : <- : numéro de face interne global
*----------------------------------------------------------------------------*/
void CS_PROCF (parfig, PARFIG)
(
cs_int_t *numloc,
cs_int_t *inddom,
cs_int_t *numglo
)
{
if (*inddom < 0)
*numglo = *numloc;
else if ( (*inddom == cs_glob_base_rang) &&
(*numloc <= cs_glob_maillage->nbr_fac) )
*numglo = cs_glob_maillage->num_fac[*numloc - 1];
else
*numglo = 0;
}
/*----------------------------------------------------------------------------
* Numéro de face de bord global associé à un numéro de face de bord local
* du processeur courant, sans communication avec les autres
* Renvoie le numero de face de bord en sequentiel
* Renvoie 0 si le numero local est superieur au nbre de faces de bord local
* Renvoie 0 si le rang du processeur courant n'est pas INDDOM
*
* Interface Fortran :
*
* SUBROUTINE PARFBG (NUMLOC,INDDOM,NUMGLO)
* *****************
*
* INTEGER NUMLOC : -> : numéro de face de bord local
* INTEGER INDDOM : -> : rang du domaine associé (0 à N-1)
* INTEGER NUMGLO : <- : numéro de face de bord global
*----------------------------------------------------------------------------*/
void CS_PROCF (parfbg, PARFBG)
(
cs_int_t *numloc,
cs_int_t *inddom,
cs_int_t *numglo
)
{
if (*inddom < 0)
*numglo = *numloc;
else if ( (*inddom == cs_glob_base_rang) &&
(*numloc <= cs_glob_maillage->nbr_fbr) )
*numglo = cs_glob_maillage->num_fbr[*numloc - 1];
else
*numglo = 0;
}
/*============================================================================
* Fonctions publiques
*============================================================================*/
/*----------------------------------------------------------------------------
* Somme aux entités correspondant à une interface interdomaines
* des valeurs d'une variable réelle.
*
* Les valeurs aux entités ne correspondant pas à l'interface sont inchangées,
* celles aux entités correspondant à l'interface sont sommées avec les
* valeurs distantes associées.
*----------------------------------------------------------------------------*/
void cs_parallel_interface_sr
(
fvm_interface_set_t *interfaces, /* --> jeu d'interfaces interdomaines */
cs_int_t nbr_ent, /* --> nombre d'entités associées */
cs_int_t pas, /* --> nombre de valeurs (non
* entrelacées) par entité */
cs_real_t *var /* <-> variable */
)
{
#if defined(_CS_HAVE_MPI)
int cpt_request;
int rang_dist, n_interfaces;
cs_int_t ind, ii, jj;
cs_int_t taille_tot;
fvm_lnum_t nbr_ent_loc = 0;
const fvm_lnum_t *num_ent_loc = NULL;
cs_int_t taille_cpt = 0;
cs_real_t *buf = NULL, *buf_send = NULL, *buf_recv = NULL;
const fvm_interface_t *interface = NULL;
MPI_Request *request = NULL;
MPI_Status *status = NULL;
/* Initialisation et allocation */
n_interfaces = fvm_interface_set_size(interfaces);
for (ind = 0 ; ind < n_interfaces ; ind++) {
taille_cpt
+= fvm_interface_size(fvm_interface_set_get_interface(interfaces, ind));
}
taille_tot = taille_cpt;
BFT_MALLOC(buf, taille_tot * pas * 2, cs_real_t);
BFT_MALLOC(request, n_interfaces * 2, MPI_Request);
BFT_MALLOC(status, n_interfaces * 2, MPI_Status);
/*
Émission et réception de messages des autres domaines
(avec des communications non bloquantes)
*/
cpt_request = 0;
taille_cpt = 0;
/* Réception */
for (ind = 0 ; ind < n_interfaces ; ind++) {
interface = fvm_interface_set_get_interface(interfaces, ind);
rang_dist = fvm_interface_rank(interface);
nbr_ent_loc = fvm_interface_size(interface);
buf_recv = buf + (taille_cpt*pas);
MPI_Irecv (buf_recv,
nbr_ent_loc * pas,
CS_MPI_REAL,
rang_dist,
rang_dist,
cs_glob_base_mpi_comm,
&(request[cpt_request++]));
taille_cpt += nbr_ent_loc;
}
assert(taille_cpt == taille_tot);
/* Émission */
for (ind = 0 ; ind < n_interfaces ; ind++) {
/* Préparation des données à envoyer */
interface = fvm_interface_set_get_interface(interfaces, ind);
rang_dist = fvm_interface_rank(interface);
nbr_ent_loc = fvm_interface_size(interface);
num_ent_loc = fvm_interface_get_local_num(interface);
buf_send = buf + (taille_cpt*pas);
for (ii = 0 ; ii < nbr_ent_loc ; ii++) {
for (jj = 0 ; jj < pas ; jj++)
buf_send[ii*pas + jj] = var[jj*nbr_ent + (num_ent_loc[ii] - 1)];
}
MPI_Isend (buf_send,
nbr_ent_loc * pas,
CS_MPI_REAL,
rang_dist,
(int)cs_glob_base_rang,
cs_glob_base_mpi_comm,
&(request[cpt_request++]));
taille_cpt += nbr_ent_loc;
}
assert(taille_cpt == taille_tot*2);
/* On synchronise après que tout le monde ait recu tous les messages */
MPI_Waitall (cpt_request, request, status);
BFT_FREE(request);
BFT_FREE(status);
/* On ajoute maintenant les contributions à la variable */
taille_cpt = 0; /* On se repositionnera dans la partie réception
du tableau temporaire */
for (ind = 0 ; ind < n_interfaces ; ind++) {
/* Récupération des données */
interface = fvm_interface_set_get_interface(interfaces, ind);
nbr_ent_loc = fvm_interface_size(interface);
num_ent_loc = fvm_interface_get_local_num(interface);
buf_recv = buf + (taille_cpt*pas);
for (ii = 0 ; ii < nbr_ent_loc ; ii++) {
for (jj = 0 ; jj < pas ; jj++) {
var[jj*nbr_ent + (num_ent_loc[ii] - 1)] += buf_recv[ii*pas + jj];
}
}
taille_cpt += nbr_ent_loc;
}
BFT_FREE(buf);
#endif
#if CS_PARALLEL_DEBUG_COMPTE
printf ("irang = %d, iappel = %d, tot = %d, cs_parallel_interface_sr\n",
cs_glob_base_rang,
cs_loc_num_appel_interface_sr++,
cs_loc_num_appel_tot++);
#endif
}
#ifdef __cplusplus
}
#endif /* __cplusplus */
syntax highlighted by Code2HTML, v. 0.9.1