File:  [local] / rpl / src / sommations.c
Revision 1.68: download - view: text, annotated - select for diffs - revision graph
Fri Jan 10 11:15:52 2020 UTC (4 years, 2 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_32, HEAD
Modification du copyright.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.32
    4:   Copyright (C) 1989-2020 Dr. BERTRAND Joël
    5: 
    6:   This file is part of RPL/2.
    7: 
    8:   RPL/2 is free software; you can redistribute it and/or modify it
    9:   under the terms of the CeCILL V2 License as published by the french
   10:   CEA, CNRS and INRIA.
   11:  
   12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
   13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
   15:   for more details.
   16:  
   17:   You should have received a copy of the CeCILL License
   18:   along with RPL/2. If not, write to info@cecill.info.
   19: ================================================================================
   20: */
   21: 
   22: 
   23: #include "rpl-conv.h"
   24: 
   25: 
   26: /*
   27: ================================================================================
   28:   Fonction réalisation le tri d'un vecteur de réels du plus petit au plus
   29:   grand en valeur absolue (algorithme de tri dit de Shell-Metzner)
   30: ================================================================================
   31:   Entrées : pointeur sur une structure struct_processus
   32: --------------------------------------------------------------------------------
   33:   Sorties :
   34: --------------------------------------------------------------------------------
   35:   Effets de bord : néant
   36: ================================================================================
   37: */
   38: 
   39: void
   40: tri_vecteur(real8 *vecteur, integer8 taille)
   41: {
   42:     logical1                    terminaison_boucle_1;
   43:     logical1                    terminaison_boucle_2;
   44:     logical1                    terminaison_boucle_3;
   45: 
   46:     real8                       registre;
   47: 
   48:     integer8                    ecartement;
   49:     integer8                    indice_i;
   50:     integer8                    indice_j;
   51:     integer8                    indice_k;
   52:     integer8                    indice_l;
   53: 
   54:     ecartement = taille;
   55:     terminaison_boucle_1 = d_faux;
   56: 
   57:     do
   58:     {
   59:         ecartement = ecartement / 2;
   60: 
   61:         if (ecartement >= 1)
   62:         {
   63:             indice_j = 0;
   64:             indice_k = taille - ecartement;
   65:             terminaison_boucle_2 = d_faux;
   66: 
   67:             do
   68:             {
   69:                 indice_i = indice_j;
   70:                 terminaison_boucle_3 = d_faux;
   71: 
   72:                 do
   73:                 {
   74:                     indice_l = indice_i + ecartement;
   75: 
   76:                     if ((indice_i > 0) && (indice_l > 0))
   77:                     {
   78:                         if (abs(vecteur[indice_i - 1]) >
   79:                                 abs(vecteur[indice_l - 1]))
   80:                         {
   81:                             registre = vecteur[indice_i - 1];
   82:                             vecteur[indice_i - 1] = vecteur[indice_l - 1];
   83:                             vecteur[indice_l - 1] = registre;
   84: 
   85:                             indice_i -= ecartement;
   86: 
   87:                             if (indice_i < 1)
   88:                             {
   89:                                 terminaison_boucle_3 = d_vrai;
   90:                             }
   91:                         }
   92:                         else
   93:                         {
   94:                             terminaison_boucle_3 = d_vrai;
   95:                         }
   96:                     }
   97:                     else
   98:                     {
   99:                         terminaison_boucle_3 = d_vrai;
  100:                     }
  101:                 } while(terminaison_boucle_3 == d_faux);
  102: 
  103:                 indice_j++;
  104: 
  105:                 if (indice_j > indice_k)
  106:                 {
  107:                     terminaison_boucle_2 = d_vrai;
  108:                 }
  109:             } while(terminaison_boucle_2 == d_faux);
  110:         }
  111:         else
  112:         {
  113:             terminaison_boucle_1 = d_vrai;
  114:         }
  115:     } while(terminaison_boucle_1 == d_faux);
  116: }
  117: 
  118: 
  119: /*
  120: ================================================================================
  121:   Fonction réalisation la sommation d'un vecteur de réel sans perte
  122:   de précision
  123: ================================================================================
  124:   Entrées : pointeur sur une structure struct_processus
  125: --------------------------------------------------------------------------------
  126:   Sorties :
  127: --------------------------------------------------------------------------------
  128:   Effets de bord : néant
  129: ================================================================================
  130: */
  131: 
  132: real8
  133: sommation_vecteur_reel(real8 *vecteur, integer8 *taille,
  134:         logical1 *erreur_memoire)
  135: {
  136: #if 0
  137:     unsigned long               nombre_elements;
  138:     unsigned long               pointeur;
  139: 
  140:     /*
  141:      * Sommation des termes en commençant par le plus petit.
  142:      * Algorithme optimal mais NP-complet...
  143:      */
  144: 
  145:     nombre_elements = (*taille);
  146:     (*erreur_memoire) = d_faux;
  147: 
  148:     while(nombre_elements != 1)
  149:     {
  150:         pointeur = (*taille) - nombre_elements;
  151:         tri_vecteur(&(vecteur[pointeur]), nombre_elements);
  152:         vecteur[pointeur + 1] += vecteur[pointeur];
  153:         nombre_elements--;
  154:     }
  155: 
  156:     return(vecteur[(*taille) - 1]);
  157: #else
  158:     real8               erreur;
  159:     real8               somme;
  160:     real8               registre;
  161:     real8               tampon;
  162: 
  163:     integer8            i;
  164: 
  165:     somme = 0;
  166:     erreur = 0;
  167: 
  168:     (*erreur_memoire) = d_faux;
  169: 
  170:     for(i = 0; i < (*taille); i++)
  171:     {
  172:         tampon = somme;
  173:         registre = vecteur[i] + erreur;
  174:         somme = tampon + registre;
  175:         erreur = (tampon - somme) + registre;
  176:     }
  177: 
  178:     return(somme);
  179: #endif
  180: }
  181: 
  182: 
  183: /*
  184: ================================================================================
  185:   Fonction réalisation la sommation d'un vecteur de complexes sans perte
  186:   de précision
  187: ================================================================================
  188:   Entrées : pointeur sur une structure struct_processus
  189: --------------------------------------------------------------------------------
  190:   Sorties :
  191: --------------------------------------------------------------------------------
  192:   Effets de bord : néant
  193: ================================================================================
  194: */
  195: 
  196: complex16
  197: sommation_vecteur_complexe(complex16 *vecteur, integer8 *taille,
  198:         logical1 *erreur_memoire)
  199: {
  200:     complex16                   cumul;
  201: 
  202:     real8                       *tampon;
  203: 
  204:     integer8                    i;
  205:     integer8                    nombre_elements;
  206: 
  207:     if ((tampon = sys_malloc(((size_t) (*taille)) * sizeof(real8))) == NULL)
  208:     {
  209:         (*erreur_memoire) = d_vrai;
  210: 
  211:         cumul.partie_reelle = 0;
  212:         cumul.partie_imaginaire = 0;
  213: 
  214:         return(cumul);
  215:     }
  216: 
  217:     (*erreur_memoire) = d_faux;
  218: 
  219:     /*
  220:      * Sommation des termes en commençant par le plus petit
  221:      */
  222: 
  223:     for(i = 0, nombre_elements = (*taille); i < nombre_elements;
  224:             tampon[i] = vecteur[i].partie_reelle, i++);
  225:             
  226:     cumul.partie_reelle = sommation_vecteur_reel(tampon, taille,
  227:             erreur_memoire);
  228: 
  229:     /*
  230:      * Même traitement, mais sur la partie imaginaire
  231:      */
  232: 
  233:     for(i = 0, nombre_elements = (*taille); i < nombre_elements;
  234:             tampon[i] = vecteur[i].partie_imaginaire, i++);
  235:             
  236:     cumul.partie_imaginaire = sommation_vecteur_reel(tampon, taille,
  237:             erreur_memoire);
  238: 
  239:     sys_free(tampon);
  240: 
  241:     return(cumul);
  242: }
  243: 
  244: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>