Annotation of rpl/src/sommations.c, revision 1.1
1.1 ! bertrand 1: /*
! 2: ================================================================================
! 3: RPL/2 (R) version 4.0.9
! 4: Copyright (C) 1989-2010 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, unsigned long taille)
! 41: {
! 42: logical1 terminaison_boucle_1;
! 43: logical1 terminaison_boucle_2;
! 44: logical1 terminaison_boucle_3;
! 45:
! 46: signed long indice_i;
! 47: signed long indice_j;
! 48: signed long indice_k;
! 49: signed long indice_l;
! 50:
! 51: unsigned long ecartement;
! 52:
! 53: ecartement = taille;
! 54: terminaison_boucle_1 = d_faux;
! 55:
! 56: do
! 57: {
! 58: ecartement = ecartement / 2;
! 59:
! 60: if (ecartement >= 1)
! 61: {
! 62: indice_j = 0;
! 63: indice_k = taille - ecartement;
! 64: terminaison_boucle_2 = d_faux;
! 65:
! 66: do
! 67: {
! 68: indice_i = indice_j;
! 69: terminaison_boucle_3 = d_faux;
! 70:
! 71: do
! 72: {
! 73: indice_l = indice_i + ecartement;
! 74:
! 75: if ((indice_i > 0) && (indice_l > 0))
! 76: {
! 77: if (fabs(vecteur[indice_i - 1]) >
! 78: fabs(vecteur[indice_l - 1]))
! 79: {
! 80: swap((void *) &(vecteur[indice_i - 1]),
! 81: (void *) &(vecteur[indice_l - 1]),
! 82: sizeof(real8));
! 83:
! 84: indice_i -= ecartement;
! 85:
! 86: if (indice_i < 1)
! 87: {
! 88: terminaison_boucle_3 = d_vrai;
! 89: }
! 90: }
! 91: else
! 92: {
! 93: terminaison_boucle_3 = d_vrai;
! 94: }
! 95: }
! 96: else
! 97: {
! 98: terminaison_boucle_3 = d_vrai;
! 99: }
! 100: } while(terminaison_boucle_3 == d_faux);
! 101:
! 102: indice_j++;
! 103:
! 104: if (indice_j > indice_k)
! 105: {
! 106: terminaison_boucle_2 = d_vrai;
! 107: }
! 108: } while(terminaison_boucle_2 == d_faux);
! 109: }
! 110: else
! 111: {
! 112: terminaison_boucle_1 = d_vrai;
! 113: }
! 114: } while(terminaison_boucle_1 == d_faux);
! 115: }
! 116:
! 117:
! 118: /*
! 119: ================================================================================
! 120: Fonction réalisation la sommation d'un vecteur de réel sans perte
! 121: de précision
! 122: ================================================================================
! 123: Entrées : pointeur sur une structure struct_processus
! 124: --------------------------------------------------------------------------------
! 125: Sorties :
! 126: --------------------------------------------------------------------------------
! 127: Effets de bord : néant
! 128: ================================================================================
! 129: */
! 130:
! 131: real8
! 132: sommation_vecteur_reel(real8 *vecteur, unsigned long *taille,
! 133: logical1 *erreur_memoire)
! 134: {
! 135: #if 0
! 136: unsigned long nombre_elements;
! 137: unsigned long pointeur;
! 138:
! 139: /*
! 140: * Sommation des termes en commençant par le plus petit.
! 141: * Algorithme optimal mais NP-complet...
! 142: */
! 143:
! 144: nombre_elements = (*taille);
! 145: (*erreur_memoire) = d_faux;
! 146:
! 147: while(nombre_elements != 1)
! 148: {
! 149: pointeur = (*taille) - nombre_elements;
! 150: tri_vecteur(&(vecteur[pointeur]), nombre_elements);
! 151: vecteur[pointeur + 1] += vecteur[pointeur];
! 152: nombre_elements--;
! 153: }
! 154:
! 155: return(vecteur[(*taille) - 1]);
! 156: #else
! 157: real8 erreur;
! 158: real8 somme;
! 159: real8 registre;
! 160: real8 tampon;
! 161:
! 162: unsigned long i;
! 163:
! 164: somme = 0;
! 165: erreur = 0;
! 166:
! 167: (*erreur_memoire) = d_faux;
! 168:
! 169: for(i = 0; i < (*taille); i++)
! 170: {
! 171: tampon = somme;
! 172: registre = vecteur[i] + erreur;
! 173: somme = tampon + registre;
! 174: erreur = (tampon - somme) + registre;
! 175: }
! 176:
! 177: return(somme);
! 178: #endif
! 179: }
! 180:
! 181:
! 182: /*
! 183: ================================================================================
! 184: Fonction réalisation la sommation d'un vecteur de complexes sans perte
! 185: de précision
! 186: ================================================================================
! 187: Entrées : pointeur sur une structure struct_processus
! 188: --------------------------------------------------------------------------------
! 189: Sorties :
! 190: --------------------------------------------------------------------------------
! 191: Effets de bord : néant
! 192: ================================================================================
! 193: */
! 194:
! 195: complex16
! 196: sommation_vecteur_complexe(complex16 *vecteur, unsigned long *taille,
! 197: logical1 *erreur_memoire)
! 198: {
! 199: complex16 cumul;
! 200:
! 201: real8 *tampon;
! 202:
! 203: unsigned long i;
! 204: unsigned long nombre_elements;
! 205:
! 206: if ((tampon = malloc((*taille) * sizeof(real8))) == NULL)
! 207: {
! 208: (*erreur_memoire) = d_vrai;
! 209:
! 210: cumul.partie_reelle = 0;
! 211: cumul.partie_imaginaire = 0;
! 212:
! 213: return(cumul);
! 214: }
! 215:
! 216: (*erreur_memoire) = d_faux;
! 217:
! 218: /*
! 219: * Sommation des termes en commençant par le plus petit
! 220: */
! 221:
! 222: for(i = 0, nombre_elements = (*taille); i < nombre_elements;
! 223: tampon[i] = vecteur[i].partie_reelle, i++);
! 224:
! 225: cumul.partie_reelle = sommation_vecteur_reel(tampon, taille,
! 226: erreur_memoire);
! 227:
! 228: /*
! 229: * Même traitement, mais sur la partie imaginaire
! 230: */
! 231:
! 232: for(i = 0, nombre_elements = (*taille); i < nombre_elements;
! 233: tampon[i] = vecteur[i].partie_imaginaire, i++);
! 234:
! 235: cumul.partie_imaginaire = sommation_vecteur_reel(tampon, taille,
! 236: erreur_memoire);
! 237:
! 238: free(tampon);
! 239:
! 240: return(cumul);
! 241: }
! 242:
! 243: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sommations.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src