/*============================================================================ * * 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 #include #include /* Includes BFT et FVM */ #include /* 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 */