_______________________________________________________________________________________________________________________________________
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N D I V E R S E S D ' E N T R E E D E D O N N E S E X T E R N E S : */
/* */
/* */
/* Definition : */
/* */
/* Ce fichier contient toutes les fonctions */
/* d'entree de donnees externes... */
/* */
/* */
/* Author of '$xiii/entrees$FON' : */
/* */
/* Jean-Francois COLONNA (LACTAMME, 19880000000000). */
/* */
/*************************************************************************************************************************************/
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* E N T R E E D U C O U P L E ( M O D U L E , P H A S E ) D E S O N D E L E T T E S " D I G I L O G " : */
/* */
/*************************************************************************************************************************************/
/*************************************************************************************************************************************/
/* */
/* P A R A M E T R E S S P E C I F I Q U E S : */
/* */
/*************************************************************************************************************************************/
#define TAILLE_DE_L_EN_TETE \
PARE(16) \
/* Taille de l'en-tete en octets. */
#define FORMAT_EN_TETE_DE_LIGNE \
"%2ld%4ld%4ld * " \
/* Format de lecture de l'en-tete de chaque ligne. */ \
/* */ \
/* Le 20100522111131 les "%d"s ont ete remplaces par des "%ld"s suite aux modifications */ \
/* 'v $xil/defi_K1$vv$DEF 20100317125446' sachant que "%ld" fonctionne correctement dans */ \
/* le cas ou l'on est sur un SYSTEME 'SYSTEME_32_BITS'... */
#define EN_TETE_DE_LIGNE \
PARE(-1) \
/* Code indiquant l'en-tete d'une ligne. */
#define PREMIERE_LIGNE \
PARE(1) \
/* Numero de la premiere ligne. */
#define DERNIERE_LIGNE \
PARE(60) \
/* Numero de la derniere ligne. */
#define FORMAT_DE_LIGNE \
PARE(512) \
/* Format standard d'une ligne. */
#define TAILLE_DES_BLOCS \
PARE(16) \
/* Taille des blocs d'informations. */
#define FORMAT_DU_MODULE_ET_DE_LA_PHASE \
"%3ld%3ld " \
/* Format de lecture du couple (module,phase). */ \
/* */ \
/* Le 20100522111131 les "%d"s ont ete remplaces par des "%ld"s suite aux modifications */ \
/* 'v $xil/defi_K1$vv$DEF 20100317125446' sachant que "%ld" fonctionne correctement dans */ \
/* le cas ou l'on est sur un SYSTEME 'SYSTEME_32_BITS'... */
#define BASE_DES_VALEURS \
PARE(1) \
/* Valeur minimale ou "base" du couple (module,phase), */
#define VALEUR_MAXIMALE \
PARE(64) \
/* Valeur maximale des donnees. */
#define TRAILER_ONDELETTES \
PARE(944) \
/* Nombre d'octets residuels en bout de fichier (?!?!?!?). */
/*************************************************************************************************************************************/
/* */
/* P A R A M E T R E S G E N E R A U X : */
/* */
/*************************************************************************************************************************************/
#define TAILLE_DES_ONDELETTES \
ADD2(TRAILER_ONDELETTES \
,ADD2(TAILLE_DE_L_EN_TETE \
,MUL2(LENG(PREMIERE_LIGNE,DERNIERE_LIGNE) \
,MUL2(FORMAT_DE_LIGNE \
,TAILLE_DES_BLOCS \
) \
) \
) \
) \
/* Nombre d'octets necessaires pour contenir le fichier d'entree des ondelettes. */
#define PAS_VERTICAL \
QUOD(dimY,LENG(PREMIERE_LIGNE,DERNIERE_LIGNE)) \
/* Pas d'entree vertical des donnees. */
#define PAS_HORIZONTAL \
UN \
/* Pas d'entree horizontal des donnees. */
#define FACTEUR_D_ECHELLE \
DIVI(COULEURS,LENG(BASE_DES_VALEURS,VALEUR_MAXIMALE)) \
/* Facteur d'echelle commun au module et a la phase. */
#define FACTEUR_DU_MODULE \
FACTEUR_D_ECHELLE \
/* Facteur d'echelle du module, */
#define FACTEUR_DE_LA_PHASE \
FACTEUR_D_ECHELLE \
/* Facteur d'echelle de la phase. */
#define BASE_DU_MODULE \
BASE_DES_VALEURS \
/* Base du module, */
#define BASE_DE_LA_PHASE \
BASE_DES_VALEURS \
/* Base de la phase. */
/*************************************************************************************************************************************/
/* */
/* P R O C E D U R E S N E C E S S A I R E S : */
/* */
/*************************************************************************************************************************************/
#define BEGIN_SCANF(taille_des_blocs) \
BblockV \
CALS(chain_Ncopie(donnees_courantes,ondelettes,taille_des_blocs)); \
/* Debut de 'scanf' interne : transfert des donnees courantes, afin */ \
/* d'ajouter un 'END_OF_CHAIN'. */
#define END_SCANF(taille_des_blocs) \
INCR(ondelettes,taille_des_blocs); \
EblockV \
/* Fin de 'scanf' interne : le pointeur sur les donnees courantes progresse. */
#define SCAN2(format,taille_des_blocs,donnee_1,donnee_2) \
Bblock \
BEGIN_SCANF(taille_des_blocs); \
CALS(SSca2(donnees_courantes,format,ADRESSE(donnee_1),ADRESSE(donnee_2))); \
END_SCANF(taille_des_blocs); \
Eblock \
/* Fonction interne 'SScan' a deux arguments. */
#define SCAN3(format,taille_des_blocs,donnee_1,donnee_2,donnee_3) \
Bblock \
BEGIN_SCANF(taille_des_blocs); \
CALS(SSca3(donnees_courantes,format,ADRESSE(donnee_1),ADRESSE(donnee_2),ADRESSE(donnee_3))); \
END_SCANF(taille_des_blocs); \
Eblock \
/* Fonction interne 'SScan' a trois arguments. */
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N D ' E N T R E E : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(FonctionI,Iget_ondelettes(moduleR,phaseR,nom_des_ondelettes,re_normalisation)))
DEFV(Argument,DEFV(image,moduleR));
/* Image Resultat, donnant le module, */
DEFV(Argument,DEFV(image,phaseR));
/* Image Resultat, donnant la phase. */
DEFV(Argument,DEFV(CHAR,DTb0(nom_des_ondelettes)));
/* Nom du fichier ou trouver les couples (module,phase) des ondelettes. */
DEFV(Argument,DEFV(Logical,re_normalisation));
/* Cet indicateur precise si les valeurs entrees, en plus d'etre passes de */
/* [BASE_DES_VALEURS,VALEUR_MAXIMALE] a [NOIR,BLANC], doivent etre renormalisees */
/* par rapport a leur [minimum,maximum] ('VRAI') ou pas ('FAUX'). */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/* ATTENTION : 'INIT_ERROR' est mis en tete des variables locales au cas ou des couples */
/* ('BDEFV','EDEFV') suivraient... */
BDEFV(image,module);
/* Image Resultat, donnant le module, */
BDEFV(image,phase);
/* Image Resultat, donnant la phase. */
DEFV(CHAR,INIT(POINTERc(ondelettes),kMalo(TAILLE_DES_ONDELETTES)));
/* Zone de stockage du fichier d'entree des ondelettes (pointeur vers */
/* la zone courante a prendre en compte... */
DEFV(CHAR,INIT(POINTERc(donnees_courantes),kMalo(ADD2(TAILLE_DES_BLOCS,chain_taille(C_VIDE)))));
/* Zone de stockage du bloc courant du fichier d'entree des ondelettes. */
DEFV(Int,INIT(en_tete_de_ligne,UNDEF));
/* En-tete d'un enregistrement (vaut toujours -1). */
DEFV(Int,INIT(numero_de_ligne,UNDEF));
/* Numero de la ligne courante : elle correspond en fait a */
/* (Y/PAS_VERTICAL)+(PREMIERE_LIGNE). */
DEFV(Int,INIT(format_de_ligne,UNDEF));
/* Donne la dimension horizontale (vaut donc dimX). */
DEFV(Int,INIT(valeur_du_module,UNDEF));
DEFV(Int,INIT(valeur_de_la_phase,UNDEF));
/* Valeur du couple (module,phase) courant ; mais ATTENTION, ces valeurs */
/* doivent etre des 'Int' et non pas des 'genere_p', car en effet, le fait */
/* que l'on fasse une entree en format '2X' dans 'SScan' implique un */
/* pointeur sur un 'Int'... */
DEFV(Int,INIT(minimum_du_module,INFINI));
DEFV(Int,INIT(maximum_du_module,MOINS_L_INFINI));
DEFV(Int,INIT(minimum_de_la_phase,INFINI));
DEFV(Int,INIT(maximum_de_la_phase,MOINS_L_INFINI));
/* Donnees de recherche des extrema du couple (module,phase). */
DEFV(Int,INIT(Y_defaut,UNDEF));
/* Ordonnee par "defaut" lors de la prise en compte du maillage d'entree, */
DEFV(Int,INIT(Y_exces,UNDEF));
/* Ordonnee par "exces" lors de la prise en compte du maillage d'entree. */
/*..............................................................................................................................*/
Test(PAS_D_ERREUR(CODE_ERROR(Iload_fichier(nom_des_ondelettes,ondelettes,TAILLE_DES_ONDELETTES,size_CHAR))))
Bblock
PUSH_TRANSLATION;
SET_TRANSLATION(TraX,TraY);
PUSH_ECHANTILLONNAGE;
SET_ECHANTILLONNAGE(PasX,PasY);
/* On met en place un echantillonnage permettant d'initialiser. */
CALS(Inoir(module));
/* Nettoyage du module, */
CALS(Inoir(phase));
/* Et nettoyage de la phase. */
SET_ECHANTILLONNAGE(PAS_HORIZONTAL,PAS_VERTICAL);
/* On met en place un echantillonnage correspondant au format du fichier */
/* d'entree des couples (module,phase). */
begin_colonne
Bblock
Test(IFLE(ADD2(DIVI(Y,PAS_VERTICAL),PREMIERE_LIGNE),DERNIERE_LIGNE))
Bblock
SCAN3(FORMAT_EN_TETE_DE_LIGNE,TAILLE_DE_L_EN_TETE,en_tete_de_ligne,numero_de_ligne,format_de_ligne);
/* Entree de l'en-tete de la ligne courante. */
Test(IFNE(en_tete_de_ligne,EN_TETE_DE_LIGNE))
Bblock
PRINT_ERREUR("l'en-tete de ligne est mauvaise");
CAL1(Prer1("elle vaut : %ld\n",en_tete_de_ligne));
/* Le 20100522111400 le "%d" a ete remplace par un "%ld" suite aux modifications */
/* 'v $xil/defi_K1$vv$DEF 20100317125446' sachant que "%ld" fonctionne correctement dans */
/* le cas ou l'on est sur un SYSTEME 'SYSTEME_32_BITS'... */
Eblock
ATes
Bblock
Eblock
ETes
Test(IFNE(format_de_ligne,FORMAT_DE_LIGNE))
Bblock
PRINT_ERREUR("le format de ligne est mauvais");
CAL1(Prer1("il vaut : %ld\n",format_de_ligne));
/* Le 20100522111400 le "%d" a ete remplace par un "%ld" suite aux modifications */
/* 'v $xil/defi_K1$vv$DEF 20100317125446' sachant que "%ld" fonctionne correctement dans */
/* le cas ou l'on est sur un SYSTEME 'SYSTEME_32_BITS'... */
Eblock
ATes
Bblock
Eblock
ETes
Test(IFNE(MUL2(PAS_VERTICAL,SOUS(numero_de_ligne,PREMIERE_LIGNE)),Y))
Bblock
PRINT_ERREUR("le numero de ligne est mauvais");
CAL1(Prer2("il vaut : %ld, alors que 'Y' vaut : %ld\n",numero_de_ligne,Y));
/* Le 20100522111400 les "%d"s ont ete remplaces par des "%ld"s suite aux modifications */
/* 'v $xil/defi_K1$vv$DEF 20100317125446' sachant que "%ld" fonctionne correctement dans */
/* le cas ou l'on est sur un SYSTEME 'SYSTEME_32_BITS'... */
Eblock
ATes
Bblock
Eblock
ETes
begin_ligne
Bblock
SCAN2(FORMAT_DU_MODULE_ET_DE_LA_PHASE,TAILLE_DES_BLOCS,valeur_du_module,valeur_de_la_phase);
/* Entree du couple (module,phase) courant, */
EGAL(valeur_du_module,MUL2(FACTEUR_DU_MODULE,SOUS(valeur_du_module,BASE_DU_MODULE)));
EGAL(valeur_de_la_phase,MUL2(FACTEUR_DE_LA_PHASE,SOUS(valeur_de_la_phase,BASE_DE_LA_PHASE)));
/* Et mise a l'echelle... */
EGAL(minimum_du_module,MIN2(minimum_du_module,valeur_du_module));
EGAL(maximum_du_module,MAX2(maximum_du_module,valeur_du_module));
EGAL(minimum_de_la_phase,MIN2(minimum_de_la_phase,valeur_de_la_phase));
EGAL(maximum_de_la_phase,MAX2(maximum_de_la_phase,valeur_de_la_phase));
/* Recherche des extrema du couple (module,phase). */
store_point(VIC1(valeur_du_module),module,X,Y,FVARIABLE);
store_point(VIC1(valeur_de_la_phase),phase,X,Y,FVARIABLE);
/* Generation des matrices (module,phase) sous-echantillonnees. */
Eblock
end_ligne
Eblock
ATes
Bblock
Eblock
ETes
Eblock
end_colonne
Test(IFNE(numero_de_ligne,DERNIERE_LIGNE))
Bblock
PRINT_ERREUR("le numero de la derniere ligne est mauvais");
CAL1(Prer1("il vaut : %d\n",numero_de_ligne));
Eblock
ATes
Bblock
Eblock
ETes
Test(IL_FAUT(re_normalisation))
Bblock
begin_colonne
Bblock
Test(IFLE(ADD2(DIVI(Y,PAS_VERTICAL),PREMIERE_LIGNE),DERNIERE_LIGNE))
Bblock
begin_ligne
Bblock
store_point(NIVA(MUL2(DIVI(FLOT(SOUS(load_point(phase,X,Y)
,minimum_de_la_phase
)
)
,FLOT(SOUS(maximum_de_la_phase
,minimum_de_la_phase
)
)
)
,FLOT(NIVR(BLANC))
)
)
,phase
,X,Y
,FVARIABLE
);
/* Lorsque cela est demande, on renormalise la phase... */
store_point(NIVA(MUL2(DIVI(FLOT(SOUS(FLOT(load_point(module,X,Y))
,minimum_du_module
)
)
,FLOT(SOUS(maximum_du_module
,minimum_du_module
)
)
)
,FLOT(NIVR(BLANC))
)
)
,module
,X,Y
,FVARIABLE
);
/* Lorsque cela est demande, on renormalise le module... */
Eblock
end_ligne
Eblock
ATes
Bblock
Eblock
ETes
Eblock
end_colonne
Eblock
ATes
Bblock
Eblock
ETes
SET_ECHANTILLONNAGE(PasX,PasY);
/* On met en place un echantillonnage permettant d'interpoler les valeurs */
/* entrees pour les couples (module,phase). */
begin_image
Bblock
Test(IFLT(ADD2(DIVI(Y,PAS_VERTICAL),PREMIERE_LIGNE),numero_de_ligne))
Bblock
/* On ne traite que les lignes existantes... */
Test(IZNE(REST(Y,PAS_VERTICAL)))
Bblock
/* Ensuite, on ne traite que les lignes inter-echantillonnage... */
EGAL(Y_defaut,MULD(Y,PAS_VERTICAL));
EGAL(Y_exces,MULE(Y,PAS_VERTICAL));
/* On calcule les ordonnees encadrant l'ordonnee 'Y' courante, et situees */
/* sur le maillage d'entree... */
store_point(DIVI(ADD2(MUL2(INTE(load_point(phase,X,Y_exces))
,SOUS(Y,Y_defaut)
)
,MUL2(INTE(load_point(phase,X,Y_defaut))
,SOUS(Y_exces,Y)
)
)
,SOUS(Y_exces,Y_defaut)
)
,phase
,X,Y
,FVARIABLE
);
store_point(DIVI(ADD2(MUL2(INTE(load_point(module,X,Y_exces))
,SOUS(Y,Y_defaut)
)
,MUL2(INTE(load_point(module,X,Y_defaut))
,SOUS(Y_exces,Y)
)
)
,SOUS(Y_exces,Y_defaut)
)
,module
,X,Y
,FVARIABLE
);
/* Et enfin, on complete les matrices (module,phase) sous-echantillonnees. */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
Eblock
end_image
CALS(Ix_symetrie(moduleR,module));
CALS(Ix_symetrie(phaseR,phase));
/* Puis, on procede a une symetrie d'axe 'OX' afin de mettre les basses */
/* frequences en bas, et les hautes frequences en haut... */
PULL_ECHANTILLONNAGE;
PULL_TRANSLATION;
Eblock
ATes
Bblock
Eblock
ETes
EDEFV(image,phase);
/* Image Resultat, donnant la phase, */
EDEFV(image,module);
/* Image Resultat, donnant le module. */
RETU_ERROR;
Eblock
EFonctionI
#undef SCAN3
#undef SCAN2
#undef END_SCANF
#undef BEGIN_SCANF
#undef BASE_DE_LA_PHASE
#undef BASE_DU_MODULE
#undef FACTEUR_DE_LA_PHASE
#undef FACTEUR_DU_MODULE
#undef FACTEUR_D_ECHELLE
#undef PAS_HORIZONTAL
#undef PAS_VERTICAL
#undef TAILLE_DES_ONDELETTES
#undef TRAILER_ONDELETTES
#undef VALEUR_MAXIMALE
#undef BASE_DES_VALEURS
#undef FORMAT_DU_MODULE_ET_DE_LA_PHASE
#undef TAILLE_DES_BLOCS
#undef FORMAT_DE_LIGNE
#undef DERNIERE_LIGNE
#undef PREMIERE_LIGNE
#undef EN_TETE_DE_LIGNE
#undef FORMAT_EN_TETE_DE_LIGNE
#undef TAILLE_DE_L_EN_TETE
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* E N T R E E D ' U N E M A T R I C E F L O T T A N T E " I M F T " : */
/* */
/*************************************************************************************************************************************/
/*************************************************************************************************************************************/
/* */
/* P A R A M E T R E S S P E C I F I Q U E S : */
/* */
/*************************************************************************************************************************************/
#define MARQUEUR_DE_LA_FORME \
NOIR \
/* Niveau avec lequel marquer la forme geometrique eventuellement contenue dans le champ. */
#define TAILLE_DES_BLOCS \
PARE(80) \
/* Taille des blocs d'informations. */
#define NOMBRE_D_ELEMENTS_PAR_BLOC \
PARE(5) \
/* Nombre d'elements de matrice par bloc. */
#define TAILLE_DES_ELEMENTS \
PARE(14) \
/* Taille d'un element d'information. */
#if (PRECISION_DU_Float==SIMPLE_PRECISION)
# define FORMAT_DES_ELEMENTS \
"%13e " \
/* Format de lecture d'un element de la matrice (simple precision). */
#Aif (PRECISION_DU_Float==SIMPLE_PRECISION)
#Eif (PRECISION_DU_Float==SIMPLE_PRECISION)
#if (PRECISION_DU_Float==DOUBLE_PRECISION)
# define FORMAT_DES_ELEMENTS \
"%13le " \
/* Format de lecture d'un element de la matrice (double precision). */
#Aif (PRECISION_DU_Float==DOUBLE_PRECISION)
#Eif (PRECISION_DU_Float==DOUBLE_PRECISION)
#define TAILLE_DE_LA_FIN_DE_BLOC \
SOUS(TAILLE_DES_BLOCS,MUL2(NOMBRE_D_ELEMENTS_PAR_BLOC,TAILLE_DES_ELEMENTS)) \
/* Taille de la fin de bloc. */
#define FORMAT_DE_FIN_DE_BLOC \
" " \
/* Format de fin de bloc (apres les 5 elements). */
/*************************************************************************************************************************************/
/* */
/* P A R A M E T R E S G E N E R A U X : */
/* */
/*************************************************************************************************************************************/
#define TAILLE_DU_FICHIER_DE_LA_MATRICE \
MUL2(TAILLE_DES_BLOCS,QUOE(dimXY,NOMBRE_D_ELEMENTS_PAR_BLOC)) \
/* Nombre d'octets necessaires pour contenir le fichier d'entree de la matrice, */ \
/* le nombre de blocs necessaires (non forcement pleins...) multiplie par leur */ \
/* taille. */
/*************************************************************************************************************************************/
/* */
/* P R O C E D U R E S N E C E S S A I R E S : */
/* */
/*************************************************************************************************************************************/
#define BEGIN_SCANF(taille_des_blocs) \
BblockV \
CALS(chain_Ncopie(donnees_courantes,fichier_de_la_matrice_flottante,taille_des_blocs)); \
/* Debut de 'scanf' interne : transfert des donnees courantes, afin */ \
/* d'ajouter un 'END_OF_CHAIN'. */
#define END_SCANF(taille_des_blocs) \
INCR(fichier_de_la_matrice_flottante,taille_des_blocs); \
EblockV \
/* Fin de 'scanf' interne : le pointeur sur les donnees courantes progresse. */
#define SCAN0(format,taille_des_blocs) \
Bblock \
BEGIN_SCANF(taille_des_blocs); \
CALS(SSca0(donnees_courantes,format)); \
END_SCANF(taille_des_blocs); \
Eblock \
/* Fonction interne 'SScan' a zero argument. */
#define SCAN1(format,taille_des_blocs,donnee_1) \
Bblock \
BEGIN_SCANF(taille_des_blocs); \
CALS(SSca1(donnees_courantes,format,ADRESSE(donnee_1))); \
END_SCANF(taille_des_blocs); \
Eblock \
/* Fonction interne 'SScan' a un argument. */
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N D ' E N T R E E : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(FonctionI,Iget_matrice_flottante(matriceR
,nom_de_la_matrice_flottante
,definition_de_la_forme
,calcul_des_extrema
,ARGUMENT_FACULTATIF(minimum_a_priori),ARGUMENT_FACULTATIF(maximum_a_priori)
)
)
)
DEFV(Argument,DEFV(image,matriceR));
/* Image Resultat, donnant la matrice image. */
DEFV(Argument,DEFV(CHAR,DTb0(nom_de_la_matrice_flottante)));
/* Nom du fichier ou trouver la matrice flottante. */
DEFV(Argument,DEFV(Float,definition_de_la_forme));
/* Precise avec quelle valeur flottante est codee une certaine forme geometrique */
/* contenue dans le champ. */
DEFV(Argument,DEFV(Logical,calcul_des_extrema));
/* Precise si les extrema (minimum,maximum) du champ sont a calculer ('VRAI'), ou */
/* s'il sont donnes en argument par (minimum_a_priori,maximum_a_priori) ('FAUX'). */
DEFV(Argument,DEFV(Float,minimum_a_priori));
/* Minimum du champ lorsque 'calcul_des_extrema=FAUX', */
DEFV(Argument,DEFV(Float,maximum_a_priori));
/* Maximum du champ lorsque 'calcul_des_extrema=FAUX'. */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/* ATTENTION : 'INIT_ERROR' est mis en tete des variables locales au cas ou des couples */
/* ('BDEFV','EDEFV') suivraient... */
DEFV(CHAR,INIT(POINTERc(fichier_de_la_matrice_flottante),kMalo(TAILLE_DU_FICHIER_DE_LA_MATRICE)));
/* Zone de stockage du fichier d'entree des matrices flottantes (pointeur vers */
/* la zone courante a prendre en compte... */
DEFV(CHAR,INIT(POINTERc(donnees_courantes),kMalo(ADD2(TAILLE_DES_BLOCS,chain_taille(C_VIDE)))));
/* Zone de stockage du bloc courant du fichier d'entree des matrices flottantes. */
BDEFV(imageF,matrice_flottante);
/* Matrice flottante resultante. */
BDEFV(image,masque_de_forme);
/* Afin de memoriser la forme geometrique contenue dans le champ. */
DEFV(Int,INIT(numero_de_l_element,NOMBRE_D_ELEMENTS_PAR_BLOC));
/* Permet de decompter les elements dans chaque bloc. */
DEFV(Float_SScan,INIT(valeur_de_l_element,FLOT__UNDEF));
/* Valeur de l'element courant. Mais ATTENTION : on notera le 'Float_SScan' qui rappelle */
/* que 'SScan' ne connait pas toujours la double-precision... */
DEFV(Float,INIT(minimum,INFINI));
/* Minimum courant de la matrice flottante, */
DEFV(Float,INIT(maximum,MOINS_L_INFINI));
/* Maximum courant de la matrice flottante. */
/*..............................................................................................................................*/
Test(PAS_D_ERREUR(CODE_ERROR(Iload_fichier(nom_de_la_matrice_flottante
,fichier_de_la_matrice_flottante
,TAILLE_DU_FICHIER_DE_LA_MATRICE
,size_CHAR
)
)
)
)
Bblock
PUSH_TRANSLATION;
SET_TRANSLATION(TraX,TraY);
PUSH_ECHANTILLONNAGE;
SET_ECHANTILLONNAGE(PasX,PasY);
/* On met en place un echantillonnage permettant de recuperer le fichier... */
CALS(IFinitialisation(matrice_flottante,FZERO));
/* Nettoyage... */
begin_image
Bblock
SCAN1(FORMAT_DES_ELEMENTS,TAILLE_DES_ELEMENTS,valeur_de_l_element);
/* Entree de l'element courant de la matrice, */
storeF_point(valeur_de_l_element,matrice_flottante,X,Y);
/* Et stockage... */
Test(IFNE(INTE(valeur_de_l_element),INTE(definition_de_la_forme)))
Bblock
EGAL(minimum,MIN2(minimum,valeur_de_l_element));
EGAL(maximum,MAX2(maximum,valeur_de_l_element));
/* Mise a jour de (minimum,maximum) sur la matrice flottante, meme s'ils sont */
/* donnes a priori, et ce afin de tout valider, mais bien entendu en excluant */
/* la definition de la forme geometrique incluse dans le champ (l'exclusion se */
/* en prenant la partie entiere pour eviter d'eventuelles erreurs d'arrondis)... */
Eblock
ATes
Bblock
Eblock
ETes
DECR(numero_de_l_element,I);
/* Decomptage des elements du bloc... */
Test(IZEQ(numero_de_l_element))
Bblock
SCAN0(FORMAT_DE_FIN_DE_BLOC,TAILLE_DE_LA_FIN_DE_BLOC);
/* Lorsqu'on a pris tous les elements d'un bloc, on passe au suivant... */
EGAL(numero_de_l_element,NOMBRE_D_ELEMENTS_PAR_BLOC);
/* Reinitialisation pour le prochain bloc. */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
end_image
Test(IFEQ(MARQUEUR_DE_LA_FORME,BLANC))
Bblock
PRINT_ATTENTION("la forme geometrique ne pourra apparaitre");
Eblock
ATes
Bblock
Eblock
ETes
CALS(Iblanc(masque_de_forme));
/* A priori, il n'y a pas de forme geometrique contenue dans le champ... */
begin_image
Bblock
Test(IFEQ(INTE(loadF_point(matrice_flottante,X,Y)),INTE(definition_de_la_forme)))
Bblock
storeF_point(CHOI(minimum,maximum),matrice_flottante,X,Y);
/* Les points rencontres et qui correspondent a la forme geometrique contenue */
/* dans le champ sont remplaces par le minimum (ou le maximum) du champ... */
store_point(MARQUEUR_DE_LA_FORME,masque_de_forme,X,Y,FVARIABLE);
/* Et mise a jour du masque (la forme apparaitra en "creux"). */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
end_image
Test(IL_NE_FAUT_PAS(calcul_des_extrema))
Bblock
Test(IFGE(minimum,minimum_a_priori))
Bblock
EGAL(minimum,minimum_a_priori);
/* Lorsque l'ordre est bon, on prend le minimum impose, sinon, on conserve */
/* celui que l'on a calcule afin de ne pas contrarier 'Ifloat_std'. */
Eblock
ATes
Bblock
PRINT_ERREUR("le minimum calcule est inferieur au minimum impose");
CAL1(Prer2("minimum a priori=%g minimum calcule=%g\n",minimum_a_priori,minimum));
Eblock
ETes
Test(IFLE(maximum,maximum_a_priori))
Bblock
EGAL(maximum,maximum_a_priori);
/* Lorsque l'ordre est bon, on prend le maximum impose, sinon, on conserve */
/* celui que l'on a calcule afin de ne pas contrarier 'Ifloat_std'. */
Eblock
ATes
Bblock
PRINT_ERREUR("le maximum calcule est superieur au maximum impose");
CAL1(Prer2("maximum a priori=%g maximum calcule=%g\n",maximum_a_priori,maximum));
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
Test(IFGT(minimum,maximum))
Bblock
PRINT_ERREUR("le minimum est superieur au maximum");
Eblock
ATes
Bblock
Eblock
ETes
CALS(Ifloat_std(matriceR,matrice_flottante,minimum,maximum));
/* Conversion de la matrice flottante en une image... */
CALS(Ipasse_bande(matriceR,matriceR,SUCC(SUCC(MARQUEUR_DE_LA_FORME)),PRED(BLANC),FAUX));
/* Puis, suppression du niveau reserve au marquage de la forme geometrique eventuellement */
/* contenue dans le champ. ATTENTION : autrefois, a la place de 'PRED(BLANC)', il y avait */
/* 'BLANC' tout court ; en fait la programmation de 'Ipasse_bande(...)' montre que l'on */
/* utilise le 'SUCC(...)' de cet argument, or le 'SUCC(BLANC)' n'est pas un niveau correct. */
CALS(Iminimum(matriceR,matriceR,masque_de_forme));
/* Et enfin, insertion de l'eventuelle forme geometrique... */
PULL_ECHANTILLONNAGE;
PULL_TRANSLATION;
Eblock
ATes
Bblock
PRINT_ERREUR("le fichier contenant la matrice flottante est inaccessible");
Eblock
ETes
EDEFV(image,masque_de_forme);
/* Afin de memoriser la forme geometrique contenue dans le champ. */
EDEFV(imageF,matrice_flottante);
/* Matrice flottante resultante. */
RETU_ERROR;
Eblock
EFonctionI
#undef SCAN1
#undef SCAN0
#undef END_SCANF
#undef BEGIN_SCANF
#undef TAILLE_DU_FICHIER_DE_LA_MATRICE
#undef FORMAT_DE_FIN_DE_BLOC
#undef TAILLE_DE_LA_FIN_DE_BLOC
#if (PRECISION_DU_Float==SIMPLE_PRECISION)
# undef FORMAT_DES_ELEMENTS
#Aif (PRECISION_DU_Float==SIMPLE_PRECISION)
#Eif (PRECISION_DU_Float==SIMPLE_PRECISION)
#if (PRECISION_DU_Float==DOUBLE_PRECISION)
# undef FORMAT_DES_ELEMENTS
#Aif (PRECISION_DU_Float==DOUBLE_PRECISION)
#Eif (PRECISION_DU_Float==DOUBLE_PRECISION)
#undef TAILLE_DES_ELEMENTS
#undef NOMBRE_D_ELEMENTS_PAR_BLOC
#undef TAILLE_DES_BLOCS
#undef MARQUEUR_DE_LA_FORME
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* E N T R E E D ' U N E M A T R I C E H E X A - D E C I M A L E " O N E R A " : */
/* */
/*************************************************************************************************************************************/
/*************************************************************************************************************************************/
/* */
/* P A R A M E T R E S S P E C I F I Q U E S : */
/* */
/*************************************************************************************************************************************/
#define TAILLE_DES_BLOCS \
PARE(80) \
/* Taille des blocs d'informations. */
#define NOMBRE_D_ELEMENTS_PAR_BLOC \
PARE(40) \
/* Nombre d'elements de matrice par bloc. */
#define TAILLE_DES_ELEMENTS \
PARE(2) \
/* Taille d'un element d'information. */
#define FORMAT_DES_ELEMENTS \
"%2X" \
/* Format de lecture d'un element de la matrice. */
#define TAILLE_DE_LA_FIN_DE_BLOC \
SOUS(TAILLE_DES_BLOCS,MUL2(NOMBRE_D_ELEMENTS_PAR_BLOC,TAILLE_DES_ELEMENTS)) \
/* Taille de la fin de bloc. */
#define FORMAT_DE_FIN_DE_BLOC \
"" \
/* Format de fin de bloc (apres les elements). */
#define MATRICE_NETTOYER \
VRAI \
/* Faut-il nettoyer avant la rotation ? */
#define MATRICE_ANGLE \
PI_SUR_2 \
/* Angle de la rotation. */
#define MATRICE_INTERPOLER \
FAUX \
/* Faut-il interpoler apres la rotation ? */
/*************************************************************************************************************************************/
/* */
/* P A R A M E T R E S G E N E R A U X : */
/* */
/*************************************************************************************************************************************/
#define TAILLE_DU_FICHIER_DE_LA_MATRICE \
MUL2(TAILLE_DES_BLOCS \
,QUOE(dimXY \
,NOMBRE_D_ELEMENTS_PAR_BLOC \
) \
) \
/* Nombre d'octets necessaires pour contenir le fichier d'entree de la matrice, */ \
/* le nombre de blocs necessaires (non forcement pleins...) multiplie par leur */ \
/* taille. */
/*************************************************************************************************************************************/
/* */
/* P R O C E D U R E S N E C E S S A I R E S : */
/* */
/*************************************************************************************************************************************/
#define BEGIN_SCANF(taille_des_blocs) \
BblockV \
CALS(chain_Ncopie(donnees_courantes,fichier_de_la_matrice_hexa_decimale,taille_des_blocs)); \
/* Debut de 'scanf' interne : transfert des donnees courantes, afin */ \
/* d'ajouter un 'END_OF_CHAIN'. */
#define END_SCANF(taille_des_blocs) \
INCR(fichier_de_la_matrice_hexa_decimale,taille_des_blocs); \
EblockV \
/* Fin de 'scanf' interne : le pointeur sur les donnees courantes progresse. */
#define SCAN0(format,taille_des_blocs) \
Bblock \
BEGIN_SCANF(taille_des_blocs); \
CALS(SSca0(donnees_courantes,format)); \
END_SCANF(taille_des_blocs); \
Eblock \
/* Fonction interne 'SScan' a zero argument. */
#define SCAN1(format,taille_des_blocs,donnee_1) \
Bblock \
BEGIN_SCANF(taille_des_blocs); \
CALS(SSca1(donnees_courantes,format,ADRESSE(donnee_1))); \
END_SCANF(taille_des_blocs); \
Eblock \
/* Fonction interne 'SScan' a un argument. */
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N D ' E N T R E E : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(FonctionI,Iget_matrice_hexa_decimale(matriceR
,nom_de_la_matrice_hexa_decimale
)
)
)
DEFV(Argument,DEFV(image,matriceR));
/* Image Resultat, donnant la matrice image. */
DEFV(Argument,DEFV(CHAR,DTb0(nom_de_la_matrice_hexa_decimale)));
/* Nom du fichier ou trouver la matrice hexa_decimale. */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/* ATTENTION : 'INIT_ERROR' est mis en tete des variables locales au cas ou des couples */
/* ('BDEFV','EDEFV') suivraient... */
BDEFV(image,matrice_brute);
/* Image brute, donnant la matrice intiale (correspondant aux donnees), */
BDEFV(image,matrice_tournee);
/* Image, donnant la matrice image, apres la rotation. */
DEFV(CHAR,INIT(POINTERc(fichier_de_la_matrice_hexa_decimale),kMalo(TAILLE_DU_FICHIER_DE_LA_MATRICE)));
/* Zone de stockage du fichier d'entree des matrices hexa_decimales (pointeur vers */
/* la zone courante a prendre en compte... */
DEFV(CHAR,INIT(POINTERc(donnees_courantes),kMalo(ADD2(TAILLE_DES_BLOCS,chain_taille(C_VIDE)))));
/* Zone de stockage du bloc courant du fichier d'entree des matrices */
/* hexa decimales. */
DEFV(Int,INIT(numero_de_l_element,NOMBRE_D_ELEMENTS_PAR_BLOC));
/* Permet de decompter les elements dans chaque bloc. */
DEFV(vrai_Positive_de_base,INIT(valeur_de_l_element,NIVEAU_UNDEF));
/* Valeur de l'element courant ; mais ATTENTION, cette valeur doit etre un */
/* un 'Int' et non pas un 'genere_p', car en effet, le fait que l'on fasse */
/* une entree en format '2X' dans 'SScan' implique un pointeur sur un 'Int'... */
/* */
/* Le 20100522112550 le 'Int' a ete remplace par 'vrai_Positive_de_base' suite aux */
/* modifications 'v $xil/defi_K1$vv$DEF 20100317125446'... */
DEFV(Logical,INIT(nettoyer_avant_rotation,MATRICE_NETTOYER));
/* Faut-il nettoyer avant la rotation ? */
DEFV(Float,INIT(angle,MATRICE_ANGLE));
/* Angle de la rotation a apporter a la matrcice "brute"... */
DEFV(Logical,INIT(interpoler_apres_rotation,MATRICE_INTERPOLER));
/* Faut-il boucher les trous par interpolation ? */
DEFV(deltaF_2D,Atranslation);
/* Parametres de la translation de la matrice Argument, */
DEFV(deltaF_2D,RAtranslation);
/* Parametres de la translation de la matrice Resultat pour l'acces a la matrice Argument, */
DEFV(deltaF_2D,RRtranslation);
/* Parametres de la translation de la matrice Resultat. */
/*..............................................................................................................................*/
Test(PAS_D_ERREUR(CODE_ERROR(Iload_fichier(nom_de_la_matrice_hexa_decimale
,fichier_de_la_matrice_hexa_decimale
,TAILLE_DU_FICHIER_DE_LA_MATRICE
,size_CHAR
)
)
)
)
Bblock
PUSH_TRANSLATION;
SET_TRANSLATION(TraX,TraY);
PUSH_ECHANTILLONNAGE;
SET_ECHANTILLONNAGE(PasX,PasY);
/* On met en place un echantillonnage permettant de recuperer le fichier... */
CALS(Inoir(matrice_brute));
/* Nettoyage... */
begin_image
Bblock
SCAN1(FORMAT_DES_ELEMENTS,TAILLE_DES_ELEMENTS,valeur_de_l_element);
/* Entree de l'element courant de la matrice, */
store_point(VIC1(valeur_de_l_element),matrice_brute,X,Y,FVARIABLE);
/* Et stockage... */
DECR(numero_de_l_element,I);
/* Decomptage des elements du bloc... */
Test(IZEQ(numero_de_l_element))
Bblock
SCAN0(FORMAT_DE_FIN_DE_BLOC,TAILLE_DE_LA_FIN_DE_BLOC);
/* Lorsqu'on a pris tous les elements d'un bloc, on passe au suivant... */
EGAL(numero_de_l_element,NOMBRE_D_ELEMENTS_PAR_BLOC);
/* Reinitialisation pour le prochain bloc. */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
end_image
CALS(Inoir(matrice_tournee));
/* Vaut mieux etre prudent (a cause de la rotation...). */
INITIALISATION_ACCROISSEMENT_2D(Atranslation
,X_A_TRANSLATION_POUR_ROTATION
,Y_A_TRANSLATION_POUR_ROTATION
);
INITIALISATION_ACCROISSEMENT_2D(RAtranslation
,X_RA_TRANSLATION_POUR_ROTATION
,Y_RA_TRANSLATION_POUR_ROTATION
);
INITIALISATION_ACCROISSEMENT_2D(RRtranslation
,X_RR_TRANSLATION_POUR_ROTATION
,Y_RR_TRANSLATION_POUR_ROTATION
);
/* Mise en place des parametres de translation, */
CALS(Irotation_image(matrice_tournee
,matrice_brute
,nettoyer_avant_rotation
,ADRESSE(RRtranslation),ADRESSE(RAtranslation),ADRESSE(Atranslation)
,angle
,interpoler_apres_rotation
)
);
/* Rotation finale, */
CALS(Inoir(matriceR));
/* Vaut mieux etre prudent (a cause de la symetrie...). */
CALS(Ix_symetrie(matriceR,matrice_tournee));
/* Puis, symetrie d'axe 'OX'. */
PULL_ECHANTILLONNAGE;
PULL_TRANSLATION;
Eblock
ATes
Bblock
Eblock
ETes
EDEFV(image,matrice_tournee);
/* Image, donnant la matrice image, apres la rotation, */
EDEFV(image,matrice_brute);
/* Image brute, donnant la matrice intiale (correspondant aux donnees). */
RETU_ERROR;
Eblock
EFonctionI
#undef SCAN1
#undef SCAN0
#undef END_SCANF
#undef BEGIN_SCANF
#undef TAILLE_DU_FICHIER_DE_LA_MATRICE
#undef MATRICE_INTERPOLER
#undef MATRICE_ANGLE
#undef MATRICE_NETTOYER
#undef FORMAT_DE_FIN_DE_BLOC
#undef TAILLE_DE_LA_FIN_DE_BLOC
#undef FORMAT_DES_ELEMENTS
#undef TAILLE_DES_ELEMENTS
#undef NOMBRE_D_ELEMENTS_PAR_BLOC
#undef TAILLE_DES_BLOCS
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* R E C U P E R A T I O N D E P O I N T S B I - D I M E N S I O N N E L S */
/* A P A R T I R D ' U N P R O G R A M M E F O R T R A N : */
/* */
/*************************************************************************************************************************************/
/* ATTENTION : les "#define" associes ne sont pas conditionnels afin de simplifier le */
/* traitement simultane de 'point2d_(...)' et 'point3d_(...)'. */
#define INITIALISATION_DU_TRANSFERT_DES_POINTS_2D \
SIGNE_MOINS \
/* Initialisation du processus, */
#define RANGEMENT_D_UN_POINT_2D \
SIGNE_NUL \
/* Rangement d'un point {X,Y}, */
#define FIN_DE_TRANSFERT_DES_POINTS_2D \
SIGNE_PLUS \
/* Fermeture... */
#define IMAGE_DES_POINTS_2D \
NOM_PIPE \
/* Nom de l'image dans laquelle stocker les points bi-dimensionnels : l'image */ \
/* Resultat est transmise via un PIPE afin de ne faire aucune hypothese */ \
/* sur son nom, et eviter des problemes de passage de chaines de caracteres */ \
/* d'un programme FORTRAN a un programme C. */
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N D ' E N T R E E : */
/* */
/*************************************************************************************************************************************/
#ifdef __VERSION__COMPILER_LA_FONCTION_point2d_ /* Common,DEFV(Fonction,) : indicateur de VERSION. */
DEFV(Common,DEFV(Logical,_______VERSION__COMPILER_LA_FONCTION_point2d_));
#Aifdef __VERSION__COMPILER_LA_FONCTION_point2d_ /* Common,DEFV(Fonction,) : indicateur de VERSION. */
#Eifdef __VERSION__COMPILER_LA_FONCTION_point2d_ /* Common,DEFV(Fonction,) : indicateur de VERSION. */
#ifdef __VERSION__COMPILER_LA_FONCTION_point2d_ /* Common,DEFV(Fonction,) : fonction 'point2d_(...)' */
/* ATTENTION : les "#define" associes ne sont pas conditionnels afin de simplifier le */
/* traitement simultane de 'point2d_(...)' et 'point3d_(...)'. */
BFonctionP
DEFV(Common,DEFV(FonctionP,POINTERp(point2d_(ARGUMENT_POINTEUR(cX)
,ARGUMENT_POINTEUR(cY)
,ARGUMENT_POINTEUR(translation_OX)
,ARGUMENT_POINTEUR(translation_OY)
,ARGUMENT_POINTEUR(niveau)
,ARGUMENT_POINTEUR(fonction_a_realiser)
)
)
)
)
/* Nota : les POINTEURs sont rendus obligatoires par l'appel depuis FORTRAN */
/* de meme que l'"underscore" en fin du nom de la fonction. Le programme FORTRAN */
/* devra obligatoirement avoir la forme suivante : */
/* */
/* DOUBLE PRECISION Xf,Yf */
/* DOUBLE PRECISION tX,tY */
/* CHARACTER*1 niveau */
/* INTEGER fonction */
/* Xf=... */
/* Yf=... */
/* tX=... */
/* tY=... */
/* niveau=... */
/* fonction=... */
/* CALL point2d(Xf,Yf,tX,tY,niveau,fonction) */
/* */
/* donc attention en particulier au 'DOUBLE PRECISION' (du a la definition de 'Float'), */
/* et a surtout ne pas passer directement des constantes, mais uniquement des variables */
/* correctement typees... */
DEFV(Argument,DEFV(Float,POINTEUR(cX)));
/* Abscisse dans [0,1], */
DEFV(Argument,DEFV(Float,POINTEUR(cY)));
/* Ordonnee dans [0,1], */
DEFV(Argument,DEFV(Float,POINTEUR(translation_OX)));
/* Translation de l'abscisse dans [0,1], */
DEFV(Argument,DEFV(Float,POINTEUR(translation_OY)));
/* Translation de l'ordonnee dans [0,1], */
DEFV(Argument,DEFV(genere_p,POINTEUR(niveau)));
/* Niveau de marquage des points. */
DEFV(Argument,DEFV(Int,POINTEUR(fonction_a_realiser)));
/* Fonction a realiser : */
/* */
/* INITIALISATION_DU_TRANSFERT_DES_POINTS_2D (<0) : initialisation, */
/* RANGEMENT_D_UN_POINT_2D (=0) : rangement d'un point {X,Y}, */
/* FIN_DE_TRANSFERT_DES_POINTS_2D (>0) : fermeture... */
/* */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(Statique,DEFV(image,imageR));
/* L'image que l'on va generer est rendue statique afin d'etre retrouvee */
/* d'un appel a l'autre... */
/*..............................................................................................................................*/
Choi(INDIRECT(fonction_a_realiser))
Bblock
Ca1e(INITIALISATION_DU_TRANSFERT_DES_POINTS_2D)
Bblock
CALS(Inoir(imageR));
/* Initialisation a 'NOIR' de l'image Resultat. */
Eblock
ECa1
Ca1e(RANGEMENT_D_UN_POINT_2D)
Bblock
store_point_2D(INDIRECT(niveau)
,imageR
,ADD2(_cDENORMALISE_OX(INDIRECT(cX)),_lDENORMALISE_OX(INDIRECT(translation_OX)))
,ADD2(_cDENORMALISE_OY(INDIRECT(cY)),_lDENORMALISE_OY(INDIRECT(translation_OY)))
);
/* Rangement d'un point bi-dimensionnel. */
Eblock
ECa1
Ca1e(FIN_DE_TRANSFERT_DES_POINTS_2D)
Bblock
CALS(Iupdate_image(IMAGE_DES_POINTS_2D,imageR));
/* L'image Resultat est transmise via un PIPE afin de ne faire aucune hypothese */
/* sur son nom, et eviter des problemes de passage de chaines de caracteres */
/* d'un programme FORTRAN a un programme C. */
Eblock
ECa1
Defo
Bblock
PRINT_ERREUR("la fonction demandee a 'point2d' n'existe pas");
Eblock
EDef
Eblock
ECho
RETI(imageR);
Eblock
EFonctionP
#Aifdef __VERSION__COMPILER_LA_FONCTION_point2d_ /* Common,DEFV(Fonction,) : fonction 'point2d_(...)' */
#Eifdef __VERSION__COMPILER_LA_FONCTION_point2d_ /* Common,DEFV(Fonction,) : fonction 'point2d_(...)' */
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* D O N N E E S D E T R A N S F O R M A T I O N G E O M E T R I Q U E 3 D : */
/* */
/*************************************************************************************************************************************/
/* ATTENTION : les "#define" associes ne sont pas conditionnels afin de simplifier le */
/* traitement simultane de 'point2d_(...)' et 'point3d_(...)'. */
#define TRANSFORMATION_Fx(fx,fy,fz) \
TRANSFORMATION_GEOMETRIQUE_3D_Fx(INDIRECT(fx) \
,INDIRECT(fy) \
,INDIRECT(fz) \
,INDIRECT(translation_OX) \
)
#define TRANSFORMATION_Fy(fx,fy,fz) \
TRANSFORMATION_GEOMETRIQUE_3D_Fy(INDIRECT(fx) \
,INDIRECT(fy) \
,INDIRECT(fz) \
,INDIRECT(translation_OY) \
)
#define TRANSFORMATION_Fz(fx,fy,fz) \
TRANSFORMATION_GEOMETRIQUE_3D_Fz(INDIRECT(fx) \
,INDIRECT(fy) \
,INDIRECT(fz) \
,INDIRECT(translation_OZ) \
)
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* R E C U P E R A T I O N D E P O I N T S T R I - D I M E N S I O N N E L S */
/* A P A R T I R D ' U N P R O G R A M M E F O R T R A N : */
/* */
/*************************************************************************************************************************************/
/* ATTENTION : les "#define" associes ne sont pas conditionnels afin de simplifier le */
/* traitement simultane de 'point2d_(...)' et 'point3d_(...)'. */
#define INITIALISATION_DU_TRANSFERT_DES_POINTS_3D \
INITIALISATION_DU_TRANSFERT_DES_POINTS_2D \
/* Initialisation du processus, */
#define RANGEMENT_D_UN_POINT_3D \
RANGEMENT_D_UN_POINT_2D \
/* Rangement d'un point {X,Y,Z}, */
#define FIN_DE_TRANSFERT_DES_POINTS_3D \
FIN_DE_TRANSFERT_DES_POINTS_2D \
/* Fermeture... */
#define IMAGE_DES_POINTS_3D \
IMAGE_DES_POINTS_2D \
/* Nom de l'image dans laquelle stocker les points tri-dimensionnels : l'image */ \
/* Resultat est transmise via un PIPE afin de ne faire aucune hypothese */ \
/* sur son nom, et eviter des problemes de passage de chaines de caracteres */ \
/* d'un programme FORTRAN a un programme C. */
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N D ' E N T R E E : */
/* */
/*************************************************************************************************************************************/
#ifdef __VERSION__COMPILER_LA_FONCTION_point3d_ /* Common,DEFV(Fonction,) : indicateur de VERSION. */
DEFV(Common,DEFV(Logical,_______VERSION__COMPILER_LA_FONCTION_point3d_));
#Aifdef __VERSION__COMPILER_LA_FONCTION_point3d_ /* Common,DEFV(Fonction,) : indicateur de VERSION. */
#Eifdef __VERSION__COMPILER_LA_FONCTION_point3d_ /* Common,DEFV(Fonction,) : indicateur de VERSION. */
#ifdef __VERSION__COMPILER_LA_FONCTION_point3d_ /* Common,DEFV(Fonction,) : fonction 'point3d_(...)' */
/* ATTENTION : les "#define" associes ne sont pas conditionnels afin de simplifier le */
/* traitement simultane de 'point2d_(...)' et 'point3d_(...)'. */
BFonctionP
DEFV(Common,DEFV(FonctionP,POINTERp(point3d_(ARGUMENT_POINTEUR(cX)
,ARGUMENT_POINTEUR(cY)
,ARGUMENT_POINTEUR(cZ)
,ARGUMENT_POINTEUR(translation_OX)
,ARGUMENT_POINTEUR(translation_OY)
,ARGUMENT_POINTEUR(translation_OZ)
,ARGUMENT_POINTEUR(niveau)
,ARGUMENT_POINTEUR(fonction_a_realiser)
)
)
)
)
/* Nota : les POINTEURs sont rendus obligatoires par l'appel depuis FORTRAN */
/* de meme que l'"underscore" en fin du nom de la fonction. Le programme FORTRAN */
/* devra obligatoirement avoir la forme suivante : */
/* */
/* DOUBLE PRECISION Xf,Yf,Zf */
/* DOUBLE PRECISION tX,tY,tZ */
/* CHARACTER*1 niveau */
/* INTEGER fonction */
/* Xf=... */
/* Yf=... */
/* Zf=... */
/* tX=... */
/* tY=... */
/* tZ=... */
/* niveau=... */
/* fonction=... */
/* CALL point3d(Xf,Yf,Zf,tX,tY,tZ,niveau,fonction) */
/* */
/* donc attention en particulier au 'DOUBLE PRECISION' (du a la definition de 'Float'), */
/* et a surtout ne pas passer directement des constantes, mais uniquement des variables */
/* correctement typees... */
DEFV(Argument,DEFV(Float,POINTEUR(cX)));
/* Abscisse dans [0,1], */
DEFV(Argument,DEFV(Float,POINTEUR(cY)));
/* Ordonnee dans [0,1], */
DEFV(Argument,DEFV(Float,POINTEUR(cZ)));
/* Troisieme coordonnee dans [0,1]. */
DEFV(Argument,DEFV(Float,POINTEUR(translation_OX)));
/* Translation de l'abscisse dans [0,1], */
DEFV(Argument,DEFV(Float,POINTEUR(translation_OY)));
/* Translation de l'ordonnee dans [0,1], */
DEFV(Argument,DEFV(Float,POINTEUR(translation_OZ)));
/* Translation de la troisieme coordonnee dans [0,1]. */
DEFV(Argument,DEFV(genere_p,POINTEUR(niveau)));
/* Niveau de marquage des points. */
DEFV(Argument,DEFV(Int,POINTEUR(fonction_a_realiser)));
/* Fonction a realiser : */
/* */
/* INITIALISATION_DU_TRANSFERT_DES_POINTS_3D (<0) : initialisation, */
/* RANGEMENT_D_UN_POINT_3D (=0) : rangement d'un point {X,Y,Z}, */
/* FIN_DE_TRANSFERT_DES_POINTS_3D (>0) : fermeture... */
/* */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(Statique,DEFV(image,imageR));
/* L'image que l'on va generer est rendue statique afin d'etre retrouvee */
/* d'un appel a l'autre... */
DEFV(Float,INIT(Xf,FLOT__UNDEF));
DEFV(Float,INIT(Yf,FLOT__UNDEF));
DEFV(Float,INIT(Zf,FLOT__UNDEF));
/* Definition des coordonnees flottantes apres transformation et projection. Elles sont */
/* introduites, plutot que d'etre calculees implicitement dans 'store_point_3D' (comme */
/* cela fut le cas "autrefois"), afin d'alleger le travail de compilation... */
/*..............................................................................................................................*/
INITIALISATION_TRANSFORMATION;
/* Au cas ou la transformation geometrique tri-dimensionnelle ne serait */
/* pas initialisee, on le fait sur la transformation unite. */
Choi(INDIRECT(fonction_a_realiser))
Bblock
Ca1e(INITIALISATION_DU_TRANSFERT_DES_POINTS_3D)
Bblock
CALS(Inoir(imageR));
/* Initialisation a 'NOIR' de l'image Resultat. */
Eblock
ECa1
Ca1e(RANGEMENT_D_UN_POINT_3D)
Bblock
EGAL(Xf
,Projection_OX(TRANSFORMATION_Fx(cX,cY,cZ)
,TRANSFORMATION_Fy(cX,cY,cZ)
,TRANSFORMATION_Fz(cX,cY,cZ)
)
);
/* Obtention de la coordonnee 'Xf' par transformation tri-dimensionnelle et projection, */
EGAL(Yf
,Projection_OY(TRANSFORMATION_Fx(cX,cY,cZ)
,TRANSFORMATION_Fy(cX,cY,cZ)
,TRANSFORMATION_Fz(cX,cY,cZ)
)
);
/* Obtention de la coordonnee 'Yf' par transformation tri-dimensionnelle et projection, */
EGAL(Zf
,TRANSFORMATION_Fz(cX,cY,cZ)
);
/* Obtention de la coordonnee 'Zf' par transformation tri-dimensionnelle. */
store_point_3D(INDIRECT(niveau)
,imageR
,_cDENORMALISE_OX(Xf),_cDENORMALISE_OY(Yf),Zf
);
/* Rangement d'un point tri-dimensionnel via le 'Z-Buffer' ; rappelons que la troisieme */
/* coordonnee 'Z' est memorisee dans [0,1] dans le 'Z-Buffer'. */
Eblock
ECa1
Ca1e(FIN_DE_TRANSFERT_DES_POINTS_3D)
Bblock
CALS(Iupdate_image(IMAGE_DES_POINTS_3D,imageR));
/* L'image Resultat est transmise via un PIPE afin de ne faire aucune hypothese */
/* sur son nom, et eviter des problemes de passage de chaines de caracteres */
/* d'un programme FORTRAN a un programme C. */
Eblock
ECa1
Defo
Bblock
PRINT_ERREUR("la fonction demandee a 'point3d' n'existe pas");
Eblock
EDef
Eblock
ECho
RETI(imageR);
Eblock
EFonctionP
#Aifdef __VERSION__COMPILER_LA_FONCTION_point3d_ /* Common,DEFV(Fonction,) : fonction 'point3d_(...)' */
#Eifdef __VERSION__COMPILER_LA_FONCTION_point3d_ /* Common,DEFV(Fonction,) : fonction 'point3d_(...)' */
/* ATTENTION : les "#define" associes ne sont pas conditionnels afin de simplifier le */
/* traitement simultane de 'point2d_(...)' et 'point3d_(...)'. */
#undef IMAGE_DES_POINTS_3D
#undef FIN_DE_TRANSFERT_DES_POINTS_3D
#undef RANGEMENT_D_UN_POINT_3D
#undef INITIALISATION_DU_TRANSFERT_DES_POINTS_3D
#undef TRANSFORMATION_Fz
#undef TRANSFORMATION_Fy
#undef TRANSFORMATION_Fx
#undef IMAGE_DES_POINTS_2D
#undef FIN_DE_TRANSFERT_DES_POINTS_2D
#undef RANGEMENT_D_UN_POINT_2D
#undef INITIALISATION_DU_TRANSFERT_DES_POINTS_2D
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* E N T R E E D ' U N E M A T R I C E B I N A I R E " S M C " : */
/* */
/*************************************************************************************************************************************/
/*************************************************************************************************************************************/
/* */
/* P A R A M E T R E S S P E C I F I Q U E S : */
/* */
/*************************************************************************************************************************************/
#define TAILLE_DES_ELEMENTS \
size_CHAR \
/* Taille d'un element d'information. */
#define NOMBRE_DE_POINTS \
MOIT(dimX) \
/* Nombre de points dans un bloc. */
#define TAILLE_DES_BLOCS \
MUL2(NOMBRE_DE_POINTS,TAILLE_DES_ELEMENTS) \
/* Taille des blocs d'informations. */
#define NOMBRE_DE_BLOCS \
MOIT(dimY) \
/* Nombre de blocs d'informations. */
/*************************************************************************************************************************************/
/* */
/* P A R A M E T R E S G E N E R A U X : */
/* */
/*************************************************************************************************************************************/
#define TAILLE_DU_FICHIER_DE_LA_MATRICE \
MUL2(TAILLE_DES_BLOCS,NOMBRE_DE_BLOCS) \
/* Nombre d'octets necessaires pour contenir le fichier d'entree de la matrice, */ \
/* le nombre de blocs necessaires (non forcement pleins...) multiplie par leur */ \
/* taille. */
/*************************************************************************************************************************************/
/* */
/* P R O C E D U R E S N E C E S S A I R E S : */
/* */
/*************************************************************************************************************************************/
#define BEGIN_READF(taille_des_elements) \
BblockV \
/* Debut de la psudo-lecture du fichier... */
#define END_READF(taille_des_elements) \
INCR(fichier_de_la_matrice_binaire_SMC,taille_des_elements); \
EblockV \
/* Fin de la pseudo-lecture interne : le pointeur sur les donnees courantes progresse. */
#define READ1(taille_des_elements,donnee_1) \
Bblock \
BEGIN_READF(taille_des_elements); \
EGAL(donnee_1,INDIRECT(fichier_de_la_matrice_binaire_SMC)); \
END_READF(taille_des_elements); \
Eblock \
/* Fonction interne de pseudo-lecture interne du fichier a un argument. */
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N D ' E N T R E E : */
/* */
/*************************************************************************************************************************************/
BFonctionP
DEFV(Common,DEFV(FonctionP,POINTERp(Iget_matrice_binaire_SMC(imageR
,nom_de_la_matrice_binaire_SMC
)
)
)
)
DEFV(Argument,DEFV(image,imageR));
/* Image Resultat, donnant la matrice image. */
DEFV(Argument,DEFV(CHAR,DTb0(nom_de_la_matrice_binaire_SMC)));
/* Nom du fichier ou trouver la matrice binaire SMC. */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/* ATTENTION : 'INIT_ERROR' est mis en tete des variables locales au cas ou des couples */
/* ('BDEFV','EDEFV') suivraient... */
/* */
/* ATTENTION : bien qu'etant une 'FonctionP', il faut ce 'INIT_ERROR' a cause du test */
/* 'Test(PAS_D_ERREUR(CODE_ERROR(...))'... */
DEFV(CHAR,INIT(POINTERc(fichier_de_la_matrice_binaire_SMC),kMalo(TAILLE_DU_FICHIER_DE_LA_MATRICE)));
/* Zone de stockage du fichier d'entree des matrices binaire_SMCs (pointeur vers */
/* la zone courante a prendre en compte... */
DEFV(genere_p,INIT(valeur_de_l_element,NIVEAU_UNDEF));
/* Valeur de l'element courant. */
/*..............................................................................................................................*/
Test(IFOU(IFNE(DOUB(NOMBRE_DE_BLOCS),dimY),IFNE(DOUB(NOMBRE_DE_POINTS),dimX)))
Bblock
PRINT_ATTENTION("l'entree des matrices SMC va mal se passer");
Eblock
ATes
Bblock
Eblock
ETes
Test(PAS_D_ERREUR(CODE_ERROR(Iload_fichier(nom_de_la_matrice_binaire_SMC
,fichier_de_la_matrice_binaire_SMC
,TAILLE_DU_FICHIER_DE_LA_MATRICE
,size_CHAR
)
)
)
)
Bblock
PUSH_TRANSLATION;
SET_TRANSLATION(TraX,TraY);
PUSH_ECHANTILLONNAGE;
SET_ECHANTILLONNAGE(PasX,PasY);
/* On met en place un echantillonnage permettant d'entrer la matrice binaire... */
CALS(Inoir(imageR));
/* Nettoyage... */
begin_colonne_back
Bblock
begin_ligne
Bblock
Test(IFET(IFEQ(X,PAR0(X)),IFEQ(Y,PAR0(Y))))
Bblock
READ1(TAILLE_DES_ELEMENTS,valeur_de_l_element);
/* Entree de l'element courant de la matrice, */
store_point_valide(valeur_de_l_element,imageR,NEUT(X),NEUT(Y),FVARIABLE);
store_point_valide(valeur_de_l_element,imageR,NEUT(X),SUCY(Y),FVARIABLE);
store_point_valide(valeur_de_l_element,imageR,SUCX(X),NEUT(Y),FVARIABLE);
store_point_valide(valeur_de_l_element,imageR,SUCX(X),SUCY(Y),FVARIABLE);
/* Et stockage sous forme d'un pave... */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
end_ligne
Eblock
end_colonne_back
PULL_ECHANTILLONNAGE;
PULL_TRANSLATION;
Eblock
ATes
Bblock
Eblock
ETes
RETI(imageR);
Eblock
EFonctionP
#undef READ1
#undef END_READF
#undef BEGIN_READF
#undef TAILLE_DU_FICHIER_DE_LA_MATRICE
#undef NOMBRE_DE_BLOCS
#undef TAILLE_DES_BLOCS
#undef NOMBRE_DE_POINTS
#undef TAILLE_DES_ELEMENTS
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* E N T R E E D U C A T A L O G U E D E S G A L A X I E S D E L ' U N I V E R S C O N N U : */
/* */
/*************************************************************************************************************************************/
/*************************************************************************************************************************************/
/* */
/* D E F I N I T I O N D E L ' U N I V E R S : */
/* */
/*************************************************************************************************************************************/
#define CONSTANTE_DE_HUBBLE \
FLOT(KILO(180)) \
/* Constante de Hubble 'H' : elle vaut 180 km/s/megaparsec, ou 180000 m/s/megaparsec. */
#define MEGA_PARSEC \
MEGA(KILO(30.84e12)) \
/* 12 */ \
/* valeur en metres d'un megaparsec ; rappelons que le parsec vaut 30.84*10 kilometres, */ \
/* et qu'il correspond a la distance a laquelle l'orbite terrestre est vue sous un angle */ \
/* d'une seconde. */ \
/* 6+3 9 */ \
/* Le mega-parsec exprime en metres est donc 10 = 10 fois plus grand... */
#define OMEGA_0 \
PARE(1.000) \
/* Definition du type d'univers. */
/*************************************************************************************************************************************/
/* */
/* D E F I N I T I O N D E S M E S U R E S : */
/* */
/*************************************************************************************************************************************/
#define VOISINAGE_DU_PLAN_EQUATORIAL \
CONVERSION_DEGRES_EN_RADIANS(5) \
/* A 5 degres de part et d'autre du plan equatorial, les donnees ne sont pas fiables a */ \
/* cause de la bande de poussiere... */
/*************************************************************************************************************************************/
/* */
/* D E F I N I T I O N D ' U N E G A L A X I E : */
/* */
/*************************************************************************************************************************************/
/* Definition d'une galaxie. */
/* */
/* A cause de 'DECLARATIONS_DES_FONCTIONS_ET_DE_LEURS_ARGUMENTS_VERSION_02', il a ete */
/* necessaire le 20040617183648 de mettre dans le fichier '$DEF' associe le definitions */
/* suivantes : */
/* */
/* TypedefS(A___galaxie,galaxie) */
/* */
/* car, en effet, avec cette nouvelle VERSION, les fichiers de type '$EXT' contiendront */
/* en general des 'Argument's et il est donc necessaire que les 'A___...' correspondant */
/* soient disponibles avant ces declarations 'Argument's... */
/*************************************************************************************************************************************/
/* */
/* D E F I N I T I O N D U F I C H I E R " C A T A L O G U E " : */
/* */
/*************************************************************************************************************************************/
#define TAILLE_DES_BLOCS \
ADD2(67,chain_taille(C_VIDE)) \
/* Taille des blocs d'informations. */
#define TAILLE_DES_ELEMENTS_l_b_mag \
PARE(8) \
/* Taille d'un element d'information de type 'l', 'b' ou 'mag' (c'est-a-dire les longitudes, */ \
/* les latitudes et les magnitudes). */
#define TAILLE_DES_ELEMENTS_cz \
PARE(8) \
/* Taille d'un element d'information de type 'cz' (c'est-a-dire les decalages vers le */ \
/* rouge). */
#if (PRECISION_DU_Float==SIMPLE_PRECISION)
# define FORMAT_DES_ELEMENTS_l_b_mag \
"%8f" \
/* Format de lecture d'un element de type 'l', 'b' ou 'mag' (simple precision). ATTENTION : */ \
/* en fait, il faudrait ecrire "%8.2f", mais visiblement 'SScan(...)' n'apprecie pas... */
# define FORMAT_DES_ELEMENTS_cz \
"%8f" \
/* Format de lecture d'un element de type 'cz' (simple precision). ATTENTION : en fait, il */ \
/* faudrait ecrire "%8.0f", mais visiblement 'SScan(...)' n'apprecie pas... */
#Aif (PRECISION_DU_Float==SIMPLE_PRECISION)
#Eif (PRECISION_DU_Float==SIMPLE_PRECISION)
#if (PRECISION_DU_Float==DOUBLE_PRECISION)
# define FORMAT_DES_ELEMENTS_l_b_mag \
"%8lf" \
/* Format de lecture d'un element de type 'l', 'b' ou 'mag' (double precision). ATTENTION : */ \
/* en fait, il faudrait ecrire "%8.2lf", mais visiblement 'SScan(...)' n'apprecie pas... */
# define FORMAT_DES_ELEMENTS_cz \
"%8lf" \
/* Format de lecture d'un element de type 'cz' (double precision). ATTENTION : en fait, il */ \
/* faudrait ecrire "%8.0lf", mais visiblement 'SScan(...)' n'apprecie pas... */
#Aif (PRECISION_DU_Float==DOUBLE_PRECISION)
#Eif (PRECISION_DU_Float==DOUBLE_PRECISION)
#define TAILLE_DE_LA_FIN_DE_BLOC \
SOUS(TAILLE_DES_BLOCS \
,ADD4(TAILLE_DES_ELEMENTS_l_b_mag \
,TAILLE_DES_ELEMENTS_l_b_mag \
,TAILLE_DES_ELEMENTS_l_b_mag \
,TAILLE_DES_ELEMENTS_cz \
) \
) \
/* Taille de la fin de bloc. */
#define FORMAT_DE_FIN_DE_BLOC \
" 0.00 mmmm.nnn" \
/* Format de fin de bloc (apres les 4 elements). */
#define TAILLE_DU_FICHIER_DU_CATALOGUE_DES_GALAXIES \
MUL2(NOMBRE_DE_GALAXIES,TAILLE_DES_BLOCS) \
/* Nombre d'octets necessaires pour contenir le fichier d'entree de la matrice, */ \
/* le nombre de blocs necessaires (non forcement pleins...) multiplie par leur */ \
/* taille. */
/*************************************************************************************************************************************/
/* */
/* P R O C E D U R E S N E C E S S A I R E S P O U R L A */
/* L E C T U R E D U F I C H I E R " C A T A L O G U E " : */
/* */
/*************************************************************************************************************************************/
#define BEGIN_SCANF(taille_des_blocs) \
BblockV \
CALS(chain_Ncopie(donnees_courantes,fichier_du_catalogue_des_galaxies,taille_des_blocs)); \
/* Debut de 'scanf' interne : transfert des donnees courantes, afin */ \
/* d'ajouter un 'END_OF_CHAIN'. */
#define END_SCANF(taille_des_blocs) \
INCR(fichier_du_catalogue_des_galaxies,taille_des_blocs); \
EblockV \
/* Fin de 'scanf' interne : le pointeur sur les donnees courantes progresse. */
#define SCAN0(format,taille_des_blocs) \
Bblock \
BEGIN_SCANF(taille_des_blocs); \
CALS(SSca0(donnees_courantes,format)); \
END_SCANF(taille_des_blocs); \
Eblock \
/* Fonction interne 'SScan' a zero argument. */
#define SCAN1(format,taille_des_blocs,donnee_1) \
Bblock \
BEGIN_SCANF(taille_des_blocs); \
CALS(SSca1(donnees_courantes,format,ADRESSE(donnee_1))); \
END_SCANF(taille_des_blocs); \
Eblock \
/* Fonction interne 'SScan' a un argument. */
/*************************************************************************************************************************************/
/* */
/* P A R A M E T R E S G E N E R A U X : */
/* */
/*************************************************************************************************************************************/
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N S N E C E S S A I R E S : */
/* */
/*************************************************************************************************************************************/
#define DISTANCE_MAGNITUDE(magnitude) \
PUIX(FLOT(BASE10),DIVI(magnitude,FLOT(CINQ))) \
/* Relation entre la magnitude et la distance pour une galaxie : */ \
/* */ \
/* soient : */ \
/* */ \
/* m : la magnitude apparente (flux de rayonnement recu d'un astre), */ \
/* M : la magnitude absolue (magnitude apparente d'un astre s'il etait */ \
/* eloigne de l'observateur d'une distance de 10 parsecs, */ \
/* d : la distance en parsecs de l'astre. */ \
/* */ \
/* On a : */ \
/* */ \
/* M-m = -5.log(d) + 5, */ \
/* */ \
/* d'ou : */ \
/* */ \
/* 5 - (M-m) */ \
/* ----------- */ \
/* 5 */ \
/* d = 10 */ \
/* */
#define RED_SHIFT(vitesse_de_fuite_de_la_galaxie) \
DIVI(vitesse_de_fuite_de_la_galaxie,VITESSE_DE_LA_LUMIERE) \
/* Fonction de determination du decalage vers le rouge 'z' d'une galaxie. */
#define HUBBLE_VITESSE_DE_RECESSION(vitesse_de_fuite_de_la_galaxie,omega) \
DIVI(MUL3(FDEUX \
,vitesse_de_fuite_de_la_galaxie \
,SOUS(RED_SHIFT(vitesse_de_fuite_de_la_galaxie) \
,SOUS(omega,FDEUX) \
) \
) \
,MUL3(ADD2(FU,RED_SHIFT(vitesse_de_fuite_de_la_galaxie)) \
,ADD2(FU \
,RACX(ADD2(FU,MUL2(omega,RED_SHIFT(vitesse_de_fuite_de_la_galaxie)))) \
) \
,ADD2(SOUS(FU,omega) \
,RACX(ADD2(FU,MUL2(omega,RED_SHIFT(vitesse_de_fuite_de_la_galaxie)))) \
) \
) \
) \
/* Fonction de determination de la vitesse de recession de la galaxie. */
#define HUBBLE_VITESSE_DE_FUITE_1(vitesse_de_recession_de_la_galaxie,omega) \
DIVI(MUL2(vitesse_de_recession_de_la_galaxie,EXP2(omega)) \
,MUL3(FDEUX,VITESSE_DE_LA_LUMIERE,SOUS(omega,FDEUX)) \
) \
/* Fonction auxiliaire '1' de determination de la vitesse de fuite en fonction de la */ \
/* vitesse de recession. */
#define HUBBLE_VITESSE_DE_FUITE_2(vitesse_de_recession_de_la_galaxie,omega) \
ADD2(FU,HUBBLE_VITESSE_DE_FUITE_1(vitesse_de_recession_de_la_galaxie,omega)) \
/* Fonction auxiliaire '2' de determination de la vitesse de fuite en fonction de la */ \
/* vitesse de recession. */
#define HUBBLE_VITESSE_DE_FUITE_3(vitesse_de_recession_de_la_galaxie,omega) \
SOUS(HUBBLE_VITESSE_DE_FUITE_1(vitesse_de_recession_de_la_galaxie,omega) \
,DIVI(omega,SOUS(omega,FDEUX)) \
) \
/* Fonction auxiliaire '3' de determination de la vitesse de fuite en fonction de la */ \
/* vitesse de recession. */
#define HUBBLE_VITESSE_DE_FUITE(vitesse_de_recession_de_la_galaxie,omega) \
MUL2(DIVI(VITESSE_DE_LA_LUMIERE \
,MUL2(FDEUX,EXP2(HUBBLE_VITESSE_DE_FUITE_3(vitesse_de_recession_de_la_galaxie,omega))) \
) \
,ADD2(SOUS(omega \
,MUL3(FDEUX \
,HUBBLE_VITESSE_DE_FUITE_2(vitesse_de_recession_de_la_galaxie,omega) \
,HUBBLE_VITESSE_DE_FUITE_3(vitesse_de_recession_de_la_galaxie,omega) \
) \
) \
,RACX(SOUS(ADD2(EXP2(MUL2(FDEUX \
,HUBBLE_VITESSE_DE_FUITE_3(vitesse_de_recession_de_la_galaxie,omega) \
) \
) \
,EXP2(omega) \
) \
,MUL3(MUL2(FDEUX \
,HUBBLE_VITESSE_DE_FUITE_2(vitesse_de_recession_de_la_galaxie,omega) \
) \
,MUL2(FDEUX \
,HUBBLE_VITESSE_DE_FUITE_3(vitesse_de_recession_de_la_galaxie,omega) \
) \
,omega \
) \
) \
) \
) \
) \
/* Fonction de determination de la vitesse de fuite en fonction de la vitesse de recession. */
/*************************************************************************************************************************************/
/* */
/* G E S T I O N D E S C O O R D O N N E E S D E S G A L A X I E S E T L I S S A G E : */
/* */
/*************************************************************************************************************************************/
#define RECHERCHE_DES_EXTREMA_DES_COORDONNEES_DES_GALAXIES(extremum1,extremum3,recherche,type) \
Bblock \
EGAL(extremum1 \
,recherche(extremum1 \
,ASD2(ITb1(liste_des_galaxies_pertinentes \
,index_de_la_liste_des_galaxies_pertinentes \
) \
,Gcoordonnees \
,type \
) \
) \
); \
/* Recherche d'un extremum relatif a la coordonnee 'type'. */ \
EGAL(extremum3,recherche(extremum3,extremum1)); \
/* Recherche d'un extremum relatif aux trois coordonnees 'X', 'Y' et 'Z' simultanement, et */ \
/* ce de facon a faire que l'univers reste cubique meme apres renormalisation dans [0,1] */ \
/* des coordonnees des galaxies... */ \
Eblock \
/* Fonction de recherche des extrema des coordonnees des galaxies. */
#define NORMALISATION_DES_COORDONNEES_DES_GALAXIES(coordonnee,type) \
Bblock \
EGAL(coordonnee \
,NORM(ASD2(ITb1(liste_des_galaxies_pertinentes \
,index_de_la_liste_des_galaxies_pertinentes \
) \
,Gcoordonnees \
,type \
) \
,minimum_du_XYZ \
,maximum_du_XYZ \
) \
); \
Eblock \
/* Mises des coordonnees des galaxies dans [0,1]... */
#define FONCTION_DE_LISSAGE(carre_de_la_distance_a_la_galaxie_courante,sigma_de_l_exponentielle_au_carre) \
EXPB(NEGA(DIVI(carre_de_la_distance_a_la_galaxie_courante \
,sigma_de_l_exponentielle_au_carre \
) \
) \
) \
/* Definition de la fonction de lissage... */ \
/* */ \
/* On notera que l'on utilise 'EXPB(...)' et non pas 'EXPX(...)' a cause du bug */ \
/* 'BUG_SYSTEME_SG_C_exp'... */
#define DEMI_DIMENSION_DE_LA_BOITE_DE_LISSAGE \
FRA1(FRA10(FU)) \
/* Demi-cote de la boite cubique de lissage exprime en fraction de la dimension */ \
/* correspondante de l'univers. */
#define LIMITE_DE_LA_BOITE_DE_LISSAGE(dimension) \
INTE(MUL2(DEMI_DIMENSION_DE_LA_BOITE_DE_LISSAGE,FLOT(dimension))) \
/* Demi-cote de la boite cubique de lissage exprime en nombre de pixels en fonction */ \
/* d'une certaine dimension... */
#define CARRE_DU_RAYON_DE_LA_BOITE \
EXP2(CHOY(_____lNORMALISE_OX(LIMITE_DE_LA_BOITE_DE_LISSAGE(dimX)) \
,_____lNORMALISE_OY(LIMITE_DE_LA_BOITE_DE_LISSAGE(dimY)) \
,_____lNORMALISE_OZ(LIMITE_DE_LA_BOITE_DE_LISSAGE(dimZ)) \
) \
) \
/* Portee de la boite (qui devient en fait une boule...) defini par le carre de son rayon. */
#define VALEUR_DE_L_EXPONENTIELLE_AU_BORD_DE_LA_BOITE \
GRO1(FRA1(FRA10(FU))) \
/* Valeur que devra atteindre l'exponentielle pour 'CARRE_DU_RAYON_DE_LA_BOITE'... */
#define SIGMA_DE_L_EXPONENTIELLE_AU_CARRE \
NEGA(DIVI(CARRE_DU_RAYON_DE_LA_BOITE \
,LOGX(VALEUR_DE_L_EXPONENTIELLE_AU_BORD_DE_LA_BOITE) \
) \
) \
/* Pour normaliser le carre de la distance dans 'EXPX(...)'. Notant 'S' la racine carree */ \
/* de 'SIGMA_DE_L_EXPONENTIELLE_AU_CARRE', la fonction de lissage est : */ \
/* */ \
/* 2 */ \
/* R */ \
/* - ---- */ \
/* 2 */ \
/* S */ \
/* f = e */ \
/* */ \
/* pour : */ \
/* */ \
/* 2 2 */ \
/* R = R = 'CARRE_DU_RAYON_DE_LA_BOITE', */ \
/* 0 */ \
/* */ \
/* et */ \
/* */ \
/* f = f = 'VALEUR_DE_L_EXPONENTIELLE_AU_BORD_DE_LA_BOITE', */ \
/* 0 */ \
/* */ \
/* on a : */ \
/* */ \
/* 2 */ \
/* R */ \
/* 2 0 */ \
/* S = - --------- */ \
/* Log(f ) */ \
/* 0 */ \
/* */ \
/* ATTENTION : si la 'FONCTION_DE_LISSAGE(...)' etait changee, il conviendrait de modifier, */ \
/* eventuellement, les calculs figurant ci-dessus, et en particulier le calcul de la */ \
/* fonction inverse... */ \
/* */ \
/* On notera que l'on utilise 'EXPB(...)' et non pas 'EXPX(...)' a cause du bug */ \
/* 'BUG_SYSTEME_SG_C_exp'... */
/*************************************************************************************************************************************/
/* */
/* D O N N E E S L O C A L E S M A I S C O M M U N E S A U X D E U X F O N C T I O N S : */
/* */
/*************************************************************************************************************************************/
DEFV(Local,DEFV(Float,INIT(minimum_de_la_magnitude,F_INFINI)));
DEFV(Local,DEFV(Float,INIT(maximum_de_la_magnitude,F_MOINS_L_INFINI)));
/* Valeurs extremes des magnitudes apparentes des galaxies que l'on conserve... */
DEFV(Local,DEFV(Float,INIT(minimum_du_XYZ,F_INFINI)));
DEFV(Local,DEFV(Float,INIT(maximum_du_XYZ,F_MOINS_L_INFINI)));
/* Valeurs extremes "simultanees" de 'X','Y' et 'Z'. Ces deux valeurs sont necessaires si */
/* l'on souhaite que l'univers, apres "renormalisation" soit cubique... */
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N D ' E N T R E E D U F I C H I E R C O N T E N A N T L E C A T A L O G U E : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(FonctionI,Iget_catalogue_des_galaxies(liste_des_galaxies_pertinentes
,ARGUMENT_POINTEUR(derniere_galaxie)
,nom_du_catalogue_des_galaxies
,vitesse_de_recession_maximale
,increment_de_Rlongitude_de_la_galaxie
,increment_de_Rlatitude_de_la_galaxie
)
)
)
DEFV(Argument,DEFV(galaxie,DTb1(liste_des_galaxies_pertinentes,NOMBRE_DE_GALAXIES)));
/* Liste des galaxies pertinentes relativement a certains criteres... */
DEFV(Argument,DEFV(Positive,POINTEUR(derniere_galaxie)));
/* Index de rangement de la derniere galaxie. */
DEFV(Argument,DEFV(CHAR,DTb0(nom_du_catalogue_des_galaxies)));
/* Nom du fichier ou trouver le catalogue des galaxies. */
DEFV(Argument,DEFV(Float,vitesse_de_recession_maximale));
/* Vitesse de recession maximale des galaxies au dela de laquelle on les ignore. Cette */
/* vitesse est exprimee en metres par seconde... */
DEFV(Argument,DEFV(Float,increment_de_Rlongitude_de_la_galaxie));
DEFV(Argument,DEFV(Float,increment_de_Rlatitude_de_la_galaxie));
/* Ces deux arguments sont destines a faire tourner l'univers sous les yeux de */
/* l'observateur. */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/* ATTENTION : 'INIT_ERROR' est mis en tete des variables locales au cas ou des couples */
/* ('BDEFV','EDEFV') suivraient... */
DEFV(CHAR,INIT(POINTERc(fichier_du_catalogue_des_galaxies),kMalo(TAILLE_DU_FICHIER_DU_CATALOGUE_DES_GALAXIES)));
/* Zone de stockage du fichier d'entree du catalogue des galaxies (pointeur vers */
/* la zone courante a prendre en compte... */
DEFV(CHAR,INIT(POINTERc(donnees_courantes),kMalo(ADD2(TAILLE_DES_BLOCS,chain_taille(C_VIDE)))));
/* Zone de stockage du bloc courant du fichier d'entree du catalogue des galaxies. */
DEFV(Positive,INIT(index_global_des_galaxies,PREMIERE_GALAXIE));
/* Index global de l'ensemble des galaxies figurant dans le catalogue. */
DEFV(Positive,INIT(index_de_la_liste_des_galaxies_pertinentes,PREMIERE_GALAXIE));
/* Index de rangement des galaxies dans 'liste_des_galaxies_pertinentes' et qui est donc */
/* l'index des galaxies que l'on conserve relativement a certains criteres... */
DEFV(Float,INIT(minimum_du_X,F_INFINI));
DEFV(Float,INIT(maximum_du_X,F_MOINS_L_INFINI));
/* Valeurs extremes de 'X'. */
DEFV(Float,INIT(minimum_du_Y,F_INFINI));
DEFV(Float,INIT(maximum_du_Y,F_MOINS_L_INFINI));
/* Valeurs extremes de 'Y'. */
DEFV(Float,INIT(minimum_du_Z,F_INFINI));
DEFV(Float,INIT(maximum_du_Z,F_MOINS_L_INFINI));
/* Valeurs extremes de 'Z'. */
/*..............................................................................................................................*/
EGAL(INDIRECT(derniere_galaxie),UNDEF);
/* Index de rangement de la derniere galaxie. */
EGAL(minimum_de_la_magnitude,F_INFINI);
EGAL(maximum_de_la_magnitude,F_MOINS_L_INFINI);
/* Valeurs extremes des magnitudes apparentes des galaxies que l'on conserve... */
EGAL(minimum_du_XYZ,F_INFINI);
EGAL(maximum_du_XYZ,F_MOINS_L_INFINI);
/* Valeurs extremes "simultanees" de 'X','Y' et 'Z'. Ces deux valeurs sont necessaires si */
/* l'on souhaite que l'univers, apres "renormalisation" soit cubique... */
Test(PAS_D_ERREUR(CODE_ERROR(Iload_fichier(nom_du_catalogue_des_galaxies
,fichier_du_catalogue_des_galaxies
,TAILLE_DU_FICHIER_DU_CATALOGUE_DES_GALAXIES
,size_CHAR
)
)
)
)
Bblock
Repe(NOMBRE_DE_GALAXIES)
Bblock
DEFV(Float_SScan,INIT(Dlongitude_de_la_galaxie,FLOT__UNDEF));
/* Longitude 'l' de la galaxie exprimee en degres dans [0,360]. */
/* Mais ATTENTION : on notera le 'Float_SScan' qui rappelle que 'SScan' ne connait pas */
/* la double-precision... */
DEFV(Float_SScan,INIT(Rlongitude_de_la_galaxie,FLOT__UNDEF));
/* Longitude 'l' de la galaxie exprimee en radians dans [0,2.PI]. */
/* Mais ATTENTION : on notera le 'Float_SScan' qui rappelle que 'SScan' ne connait pas */
/* la double-precision... */
DEFV(Float_SScan,INIT(Dlatitude_de_la_galaxie,FLOT__UNDEF));
/* Latitude 'b' de la galaxie exprimee en degres dans [-90,+90] du pole Sud au pole Nord. */
/* Mais ATTENTION : on notera le 'Float_SScan' qui rappelle que 'SScan' ne connait pas */
/* la double-precision... */
DEFV(Float_SScan,INIT(Rlatitude_de_la_galaxie,FLOT__UNDEF));
/* Latitude 'b' de la galaxie exprimee en radians dans [-PI/2,+PI/2] du pole S au pole N. */
/* Mais ATTENTION : on notera le 'Float_SScan' qui rappelle que 'SScan' ne connait pas */
/* la double-precision... */
DEFV(Float_SScan,INIT(angle_au_pole_de_la_galaxie,FLOT__UNDEF));
/* Angle au pole de la galaxie exprime en radians dans [0,+PI] du pole N au pole S... */
DEFV(Float_SScan,INIT(magnitude_apparente_de_la_galaxie,FLOT__UNDEF));
/* Magnitude apparente de la galaxie. */
DEFV(Float_SScan,INIT(vitesse_de_fuite_de_la_galaxie,FLOT__UNDEF));
/* Vitesse de fuite de la galaxie exprimee en metres par seconde, et qui est egal au */
/* produit de la vitesse de la lumiere par le decalage vers le rouge mesure. */
DEFV(Float,INIT(vitesse_de_recession_de_la_galaxie,FLOT__UNDEF));
/* Vitesse de recession de la galaxie qui est egale au produit de la distance par la */
/* constante de Hubble, mais ATTENTION aux unites. On fait de plus l'hypothese que la */
/* la galaxie n'a pas de vitesse propre, et qu'ainsi, le decalage vers le rouge observe */
/* n'est que le resultat de l'expansion de l'univers... */
DEFV(Float,INIT(distance_de_la_galaxie,FLOT__UNDEF));
/* Distance de la galaxie estimee a partir de sa vitesse de fuite et du type d'univers... */
SCAN1(FORMAT_DES_ELEMENTS_l_b_mag,TAILLE_DES_ELEMENTS_l_b_mag,Dlongitude_de_la_galaxie);
/* Entree de la longitude en degres, */
SCAN1(FORMAT_DES_ELEMENTS_l_b_mag,TAILLE_DES_ELEMENTS_l_b_mag,Dlatitude_de_la_galaxie);
/* Entree de la latitude en degres, */
SCAN1(FORMAT_DES_ELEMENTS_l_b_mag,TAILLE_DES_ELEMENTS_l_b_mag,magnitude_apparente_de_la_galaxie);
/* Entree de la magnitude apparente, */
SCAN1(FORMAT_DES_ELEMENTS_cz,TAILLE_DES_ELEMENTS_cz,vitesse_de_fuite_de_la_galaxie);
/* Entree de la vitesse de fuite en kilometres par seconde. */
SCAN0(FORMAT_DE_FIN_DE_BLOC,TAILLE_DE_LA_FIN_DE_BLOC);
/* Lorsqu'on a pris tous les elements d'un bloc, on passe au suivant... */
EGAL(Rlongitude_de_la_galaxie
,ADD2(CONVERSION_DEGRES_EN_RADIANS(Dlongitude_de_la_galaxie)
,increment_de_Rlongitude_de_la_galaxie
)
);
EGAL(Rlatitude_de_la_galaxie
,ADD2(CONVERSION_DEGRES_EN_RADIANS(Dlatitude_de_la_galaxie)
,increment_de_Rlatitude_de_la_galaxie
)
);
EGAL(vitesse_de_fuite_de_la_galaxie
,KILO(vitesse_de_fuite_de_la_galaxie)
);
/* Mise des donnees utiles dans le bon systeme d'unite, avec une rotation eventuelle de */
/* l'univers sous les yeux de l'observateur. */
Test(IFGE(ABSO(Rlatitude_de_la_galaxie),VOISINAGE_DU_PLAN_EQUATORIAL))
Bblock
/* Seules les galaxies qui ne sont pas trop proches du plan equatorial sont conservees, */
/* cela etant du a la bande de poussieres qui dans ces directions perturbent les mesures... */
EGAL(angle_au_pole_de_la_galaxie
,SOUS(PI_SUR_2,Rlatitude_de_la_galaxie)
);
/* Calcul de l'angle au pole afin de travailler en coordonnees spheriques (theta,phi), ou */
/* 'phi' designe l'angle au pole, et 'theta' la longitude... */
EGAL(vitesse_de_recession_de_la_galaxie
,HUBBLE_VITESSE_DE_RECESSION(vitesse_de_fuite_de_la_galaxie,OMEGA_0)
);
/* Evaluation de la vitesse de recession de la galaxie... */
Test(IFLE(vitesse_de_recession_de_la_galaxie,vitesse_de_recession_maximale))
Bblock
/* Seules les galaxies les plus proches (la distance etant appreciee grace a la vitesse de */
/* recession) sont conservees. L'univers ainsi obtenu sera "renormalise", ce qui fait que */
/* quelle que soit 'vitesse_de_recession_maximale' choisie, les images calculees ont */
/* toujours la meme taille... */
Test(IZGT(vitesse_de_recession_de_la_galaxie))
Bblock
/* Les mesures aberrantes sont eliminees... */
EGAL(distance_de_la_galaxie
,MUL2(DIVI(vitesse_de_recession_de_la_galaxie
,CONSTANTE_DE_HUBBLE
)
,MEGA_PARSEC
)
);
/* Evaluation de la distance de la galaxie exprimee en metres (?!?!?!). */
Test(IFLE(DIVI(DISTANCE_MAGNITUDE(magnitude_apparente_de_la_galaxie)
,MUL2(vitesse_de_recession_de_la_galaxie
,ADD2(FU
,RED_SHIFT(vitesse_de_fuite_de_la_galaxie)
)
)
)
,DIVI(DISTANCE_MAGNITUDE(MAGNITUDE_LIMITE)
,MUL2(vitesse_de_recession_maximale
,ADD2(FU
,RED_SHIFT(HUBBLE_VITESSE_DE_FUITE(vitesse_de_recession_maximale,OMEGA_0))
)
)
)
)
)
Bblock
/* La galaxie courante est transportee "virtuellement" aux limites de l'univers que l'on */
/* s'est choisi par 'vitesse_de_recession_maximale' ; elle n'est alors conservee que si la */
/* magnitude apparente qu'elle aurait alors la laisse visible... */
Test(IFLE(index_de_la_liste_des_galaxies_pertinentes,TRMU(NOMBRE_DE_GALAXIES)))
Bblock
INITIALISATION_POINT_3D(ASD1(ITb1(liste_des_galaxies_pertinentes
,index_de_la_liste_des_galaxies_pertinentes
)
,Gcoordonnees
)
,Xcartesienne_3D(distance_de_la_galaxie
,Rlongitude_de_la_galaxie
,angle_au_pole_de_la_galaxie
)
,Ycartesienne_3D(distance_de_la_galaxie
,Rlongitude_de_la_galaxie
,angle_au_pole_de_la_galaxie
)
,Zcartesienne_3D(distance_de_la_galaxie
,Rlongitude_de_la_galaxie
,angle_au_pole_de_la_galaxie
)
);
EGAL(ASD1(ITb1(liste_des_galaxies_pertinentes
,index_de_la_liste_des_galaxies_pertinentes
)
,magnitude
)
,magnitude_apparente_de_la_galaxie
);
/* Rangement systematique de la galaxie recuperee en unites MKSA... */
RECHERCHE_DES_EXTREMA_DES_COORDONNEES_DES_GALAXIES(minimum_du_X,minimum_du_XYZ,MIN2,x)
RECHERCHE_DES_EXTREMA_DES_COORDONNEES_DES_GALAXIES(maximum_du_X,maximum_du_XYZ,MAX2,x)
/* Recherche des valeurs extremes des coordonnees 'X', */
RECHERCHE_DES_EXTREMA_DES_COORDONNEES_DES_GALAXIES(minimum_du_Y,minimum_du_XYZ,MIN2,y)
RECHERCHE_DES_EXTREMA_DES_COORDONNEES_DES_GALAXIES(maximum_du_Y,maximum_du_XYZ,MAX2,y)
/* Recherche des valeurs extremes des coordonnees 'Y', */
RECHERCHE_DES_EXTREMA_DES_COORDONNEES_DES_GALAXIES(minimum_du_Z,minimum_du_XYZ,MIN2,z)
RECHERCHE_DES_EXTREMA_DES_COORDONNEES_DES_GALAXIES(maximum_du_Z,maximum_du_XYZ,MAX2,z)
/* Recherche des valeurs extremes des coordonnees 'Z'. */
EGAL(minimum_de_la_magnitude
,MIN2(minimum_de_la_magnitude
,ASD1(ITb1(liste_des_galaxies_pertinentes
,index_de_la_liste_des_galaxies_pertinentes
)
,magnitude
)
)
);
EGAL(maximum_de_la_magnitude
,MAX2(maximum_de_la_magnitude
,ASD1(ITb1(liste_des_galaxies_pertinentes
,index_de_la_liste_des_galaxies_pertinentes
)
,magnitude
)
)
);
/* Valeurs extremes des magnitudes apparentes des galaxies que l'on conserve... */
INCR(index_de_la_liste_des_galaxies_pertinentes,I);
/* Et enfin, progression de l'index de rangement... */
Eblock
ATes
Bblock
PRINT_ERREUR("il y a trop de galaxies a ranger");
Eblock
ETes
Eblock
ATes
Bblock
/* Les galaxies qui seraient invisibles aux limites de l'univers que l'on s'est choisi */
/* par 'vitesse_de_recession_maximale' sont ignorees... */
Eblock
ETes
Eblock
ATes
Bblock
/* Les galaxies pour lesquelles la vitesse de recession est trouvee negative ou nulle */
/* sont ignorees... */
Eblock
ETes
Eblock
ATes
Bblock
/* Les galaxies trop eloignees sont ignorees... */
Eblock
ETes
Eblock
ATes
Bblock
/* Les galaxies trop prochent du plan equatorial sont ignorees... */
Eblock
ETes
INCR(index_global_des_galaxies,I);
/* Et progression de l'index global... */
Eblock
ERep
Test(IFLE(index_global_des_galaxies,TRMU(NOMBRE_DE_GALAXIES)))
Bblock
PRINT_ATTENTION("il y a moins de galaxies que prevues dans le fichier");
Eblock
ATes
Bblock
Eblock
ETes
EGAL(INDIRECT(derniere_galaxie),PRED(index_de_la_liste_des_galaxies_pertinentes));
/* Memorisation de l'index de la derniere galaxie. */
Eblock
ATes
Bblock
PRINT_ERREUR("le fichier contenant le catalogue des galaxies est inaccessible");
Eblock
ETes
RETU_ERROR;
Eblock
EFonctionI
#undef RECHERCHE_DES_EXTREMA_DES_COORDONNEES_DES_GALAXIES
#undef HUBBLE_VITESSE_DE_FUITE
#undef HUBBLE_VITESSE_DE_FUITE_3
#undef HUBBLE_VITESSE_DE_FUITE_2
#undef HUBBLE_VITESSE_DE_FUITE_1
#undef HUBBLE_VITESSE_DE_RECESSION
#undef RED_SHIFT
#undef DISTANCE_MAGNITUDE
#undef SCAN1
#undef SCAN0
#undef END_SCANF
#undef BEGIN_SCANF
#undef TAILLE_DU_FICHIER_DU_CATALOGUE_DES_GALAXIES
#undef FORMAT_DE_FIN_DE_BLOC
#undef TAILLE_DE_LA_FIN_DE_BLOC
#if (PRECISION_DU_Float==SIMPLE_PRECISION)
# undef FORMAT_DES_ELEMENTS_cz
# undef FORMAT_DES_ELEMENTS_l_b_mag
#Aif (PRECISION_DU_Float==SIMPLE_PRECISION)
#Eif (PRECISION_DU_Float==SIMPLE_PRECISION)
#if (PRECISION_DU_Float==DOUBLE_PRECISION)
# undef FORMAT_DES_ELEMENTS_cz
# undef FORMAT_DES_ELEMENTS_l_b_mag
#Aif (PRECISION_DU_Float==DOUBLE_PRECISION)
#Eif (PRECISION_DU_Float==DOUBLE_PRECISION)
#undef TAILLE_DES_ELEMENTS_cz
#undef TAILLE_DES_ELEMENTS_l_b_mag
#undef TAILLE_DES_BLOCS
#undef VOISINAGE_DU_PLAN_EQUATORIAL
#undef OMEGA_0
#undef MEGA_PARSEC
#undef CONSTANTE_DE_HUBBLE
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N D E V I S U A L I S A T I O N D U C A T A L O G U E D E S G A L A X I E S : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(FonctionI,Ivisualise_catalogue_des_galaxies(imageR_vue_des_galaxies
,imageR_fonction_de_densite
,imageR_structure_en_oignon
,nom_du_catalogue_des_galaxies
,vitesse_de_recession_maximale
,increment_de_Rlongitude_de_la_galaxie
,increment_de_Rlatitude_de_la_galaxie
,generer_imageR_vue_des_galaxies
,generer_imageR_fonction_de_densite
,generer_imageR_structure_en_oignon
)
)
)
DEFV(Argument,DEFV(image,imageR_vue_des_galaxies));
/* Image Resultat, donnant une vue du catalogue des galaxies chacune etant representee */
/* par un point fonction de sa magnitude. */
DEFV(Argument,DEFV(image,imageR_fonction_de_densite));
/* Image Resultat, donnant une vue du catalogue des galaxies par le biais d'une fonction */
/* de densite. */
DEFV(Argument,DEFV(image,imageR_structure_en_oignon));
/* Image Resultat, donnant une vue du catalogue des galaxies par le biais d'un "epluchage" */
/* de la structure en oignon. */
DEFV(Argument,DEFV(CHAR,DTb0(nom_du_catalogue_des_galaxies)));
/* Nom du fichier ou trouver le catalogue des galaxies. */
DEFV(Argument,DEFV(Float,vitesse_de_recession_maximale));
/* Vitesse de recession maximale des galaxies au dela de laquelle on les ignore. Cette */
/* vitesse est exprimee en metres par seconde... */
DEFV(Argument,DEFV(Float,increment_de_Rlongitude_de_la_galaxie));
DEFV(Argument,DEFV(Float,increment_de_Rlatitude_de_la_galaxie));
/* Ces deux arguments sont destines a faire tourner l'univers sous les yeux de */
/* l'observateur. */
DEFV(Argument,DEFV(Logical,generer_imageR_vue_des_galaxies));
DEFV(Argument,DEFV(Logical,generer_imageR_fonction_de_densite));
DEFV(Argument,DEFV(Logical,generer_imageR_structure_en_oignon));
/* Ces trois arguments precisent lesquelles des images Resultats doivent etre generees, mais */
/* on notera que lorsque la structure en oignon est generee, la fonction de densite est */
/* alors systematiquement calculee... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/* ATTENTION : 'INIT_ERROR' est mis en tete des variables locales au cas ou des couples */
/* ('BDEFV','EDEFV') suivraient... */
DEFV(Positive,INIT(index_de_la_liste_des_galaxies_pertinentes,PREMIERE_GALAXIE));
/* Index de rangement des galaxies dans 'liste_des_galaxies_pertinentes' et qui est donc */
/* l'index des galaxies que l'on conserve relativement a certains criteres... */
DEFV(Positive,INIT(derniere_galaxie,UNDEF));
/* Index de rangement de la derniere galaxie. */
DEFV(galaxie,DTb1(liste_des_galaxies_pertinentes,NOMBRE_DE_GALAXIES));
/* Liste des galaxies pertinentes relativement a certains criteres... */
BDEFV(imageF,vue_des_galaxies_de_l_univers);
/* Matrice dans laquelle on va situer les "voint"s simulant l'univers. Chaque galaxie y */
/* est materialisee par point de couleur fonction de sa magnitude... */
BDEFV(imageF,fonction_de_densite_de_l_univers);
/* Matrice dans laquelle on va situer les "voint"s simulant l'univers. Chaque galaxie y */
/* est materialisee par un "blob" gaussien, les "blob"s de galaxies voisines se melangeant */
/* entre eux... */
/*..............................................................................................................................*/
Test(IFET(IL_NE_FAUT_PAS(generer_imageR_fonction_de_densite)
,IL_FAUT(generer_imageR_structure_en_oignon)
)
)
Bblock
PRINT_ATTENTION("lorsque l'epluchage de l'oignon est demande, il faut generer le fonction de densite");
Eblock
ATes
Bblock
Eblock
ETes
Test(PAS_D_ERREUR(CODE_ERROR(Iget_catalogue_des_galaxies(liste_des_galaxies_pertinentes
,ADRESSE(derniere_galaxie)
,nom_du_catalogue_des_galaxies
,vitesse_de_recession_maximale
,increment_de_Rlongitude_de_la_galaxie
,increment_de_Rlatitude_de_la_galaxie
)
)
)
)
/* Lecture du fichier des galaxies, et generation de la liste des galaxies pertinentes... */
Bblock
PUSH_TRANSLATION;
SET_TRANSLATION(TraX,TraY);
PUSH_ECHANTILLONNAGE;
SET_ECHANTILLONNAGE(PasX,PasY);
/* On met en place un echantillonnage permettant de proceder aux initialisations... */
Test(IL_FAUT(generer_imageR_vue_des_galaxies))
Bblock
CALS(Inoir(imageR_vue_des_galaxies));
/* Nettoyage de l'image Resultat de type 'fonction de densite'. */
CALS(IFinitialisation(vue_des_galaxies_de_l_univers
,SOUS(minimum_de_la_magnitude
,DOUB(DIVI(SOUS(maximum_de_la_magnitude,minimum_de_la_magnitude)
,FLOT(PRED(COULEURS))
)
)
)
)
);
/* Initialisation de l'univers avant le changement des pas : la valeur est choisie de facon */
/* a ce que les plus faibles magnitudes ne soient pas confondues avec le "fond". On notera */
/* que cette image bien que contenant des "voint"s est manipulee, lorsque cela est possible */
/* comme une image bidimensionnelle... */
Eblock
ATes
Bblock
Eblock
ETes
Test(IFOU(IL_FAUT(generer_imageR_fonction_de_densite)
,IL_FAUT(generer_imageR_structure_en_oignon)
)
)
Bblock
CALS(Inoir(imageR_fonction_de_densite));
/* Nettoyage de l'image Resultat de type 'fonction de densite'. */
CALS(IFinitialisation(fonction_de_densite_de_l_univers,FZERO));
/* Mise a zero initiale de l'univers avant le changement des pas. On notera que cette image */
/* bien que contenant des "voint"s est manipulee, lorsque cela est possible comme une image */
/* bidimensionnelle... */
Eblock
ATes
Bblock
Eblock
ETes
Test(IL_FAUT(generer_imageR_structure_en_oignon))
Bblock
CALS(Inoir(imageR_structure_en_oignon));
/* Nettoyage de l'image Resultat de type 'structure en oignon'. */
Eblock
ATes
Bblock
Eblock
ETes
Test(IL_FAUT(generer_imageR_vue_des_galaxies))
Bblock
SET_ECHANTILLONNAGE_POUR_SIMULER_LES_VOINTS;
/* Mise en place d'un pas sur les trois axes compatibles avec la gestion des "voint"s. On */
/* consultera avec interet le fichier 'v $xiii/Images$DEF' a ce propos... */
DoIn(index_de_la_liste_des_galaxies_pertinentes,PREMIERE_GALAXIE,derniere_galaxie,I)
Bblock
DEFV(Float,INIT(Xf,FLOT__UNDEF));
DEFV(Float,INIT(Yf,FLOT__UNDEF));
DEFV(Float,INIT(Zf,FLOT__UNDEF));
/* Definition des coordonnees de la galaxie courante... */
NORMALISATION_DES_COORDONNEES_DES_GALAXIES(Xf,x);
NORMALISATION_DES_COORDONNEES_DES_GALAXIES(Yf,y);
NORMALISATION_DES_COORDONNEES_DES_GALAXIES(Zf,z);
/* Normalisation des coordonnees de la galaxie courante dans [0,1]. */
storeF_voint(ASD1(ITb1(liste_des_galaxies_pertinentes
,index_de_la_liste_des_galaxies_pertinentes
)
,magnitude
)
,vue_des_galaxies_de_l_univers
,_cDENORMALISE_OX(Xf),_cDENORMALISE_OY(Yf),_cDENORMALISE_OZ(Zf)
);
/* Mise a jour de la vue des galaxies de l'univers... */
Eblock
EDoI
SET_TRANSLATION(TraX,TraY);
SET_ECHANTILLONNAGE(PasX,PasY);
/* On met en place un echantillonnage permettant de tout renormaliser... */
CALS(Ifloat_std_avec_renormalisation(imageR_vue_des_galaxies,vue_des_galaxies_de_l_univers));
/* Enfin l'univers est renormalise tout en etant converti en une image "standard". On */
/* notera que cette image bien que contenant des "voint"s est manipulee, lorsque cela */
/* est possible comme une image bidimensionnelle... */
Eblock
ATes
Bblock
Eblock
ETes
Test(IFOU(IL_FAUT(generer_imageR_fonction_de_densite)
,IL_FAUT(generer_imageR_structure_en_oignon)
)
)
Bblock
SET_ECHANTILLONNAGE_POUR_SIMULER_LES_VOINTS;
/* Mise en place d'un pas sur les trois axes compatibles avec la gestion des "voint"s. On */
/* consultera avec interet le fichier 'v $xiii/Images$DEF' a ce propos... */
DoIn(index_de_la_liste_des_galaxies_pertinentes,PREMIERE_GALAXIE,derniere_galaxie,I)
Bblock
DEFV(Float,INIT(Xf,FLOT__UNDEF));
DEFV(Float,INIT(Yf,FLOT__UNDEF));
DEFV(Float,INIT(Zf,FLOT__UNDEF));
/* Definition des coordonnees de la galaxie courante... */
NORMALISATION_DES_COORDONNEES_DES_GALAXIES(Xf,x);
NORMALISATION_DES_COORDONNEES_DES_GALAXIES(Yf,y);
NORMALISATION_DES_COORDONNEES_DES_GALAXIES(Zf,z);
/* Normalisation des coordonnees de la galaxie courante dans [0,1]. */
begin_albumQ(DoIn
,COZA(SOUS(_cDENORMALISE_OZ(Zf),LIMITE_DE_LA_BOITE_DE_LISSAGE(dimZ)))
,NEUT(ADD2(_cDENORMALISE_OZ(Zf),LIMITE_DE_LA_BOITE_DE_LISSAGE(dimZ)))
,pasZ
,DoIn
,COYA(SOUS(_cDENORMALISE_OY(Yf),LIMITE_DE_LA_BOITE_DE_LISSAGE(dimY)))
,NEUT(ADD2(_cDENORMALISE_OY(Yf),LIMITE_DE_LA_BOITE_DE_LISSAGE(dimY)))
,pasY
,DoIn
,COXA(SOUS(_cDENORMALISE_OX(Xf),LIMITE_DE_LA_BOITE_DE_LISSAGE(dimX)))
,NEUT(ADD2(_cDENORMALISE_OX(Xf),LIMITE_DE_LA_BOITE_DE_LISSAGE(dimX)))
,pasX
)
Bblock
DEFV(Float,INIT(carre_de_la_distance_a_la_galaxie_courante
,disF3D(Xf,Yf,Zf
,_____cNORMALISE_OX(X),_____cNORMALISE_OY(Y),_____cNORMALISE_OZ(Z)
)
)
);
/* Carre de la distance du "voint" courant a la galaxie courante. */
Test(IFLE(carre_de_la_distance_a_la_galaxie_courante,CARRE_DU_RAYON_DE_LA_BOITE))
Bblock
/* Seuls sont conserves les "voint"s qui sont situes a l'interieur de la boule centree sur */
/* la galaxie courante, */
Test(TEST_DANS_L_ALBUM(X,Y,Z))
Bblock
/* Et qui sont de plus dans l'univers. On notera l'ordre des deux tests precedents qui est */
/* est choisi de facon que le plus "rentable" soit fait le premier... */
DEFV(genere_Float,INIT(voint_courant,FLOT__NIVEAU_UNDEF));
/* Definition du "voint" courant de l'univers, */
loadF_voint(voint_courant,fonction_de_densite_de_l_univers,X,Y,Z);
/* Et recuperation de sa valeur courante. */
storeF_voint(ADD2(voint_courant
,FONCTION_DE_LISSAGE(carre_de_la_distance_a_la_galaxie_courante
,SIGMA_DE_L_EXPONENTIELLE_AU_CARRE
)
)
,fonction_de_densite_de_l_univers
,X,Y,Z
);
/* Sa valeur est mise a jour en fonction de la contribution locale de la galaxie courante. */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
Eblock
end_albumQ(EDoI,EDoI,EDoI)
Eblock
EDoI
SET_TRANSLATION(TraX,TraY);
SET_ECHANTILLONNAGE(PasX,PasY);
/* On met en place un echantillonnage permettant de tout renormaliser... */
CALS(Ifloat_std_avec_renormalisation(imageR_fonction_de_densite,fonction_de_densite_de_l_univers));
/* Enfin l'univers est renormalise tout en etant converti en une image "standard". On */
/* notera que cette image bien que contenant des "voint"s est manipulee, lorsque cela */
/* est possible comme une image bidimensionnelle... */
Eblock
ATes
Bblock
Eblock
ETes
Test(IL_FAUT(generer_imageR_structure_en_oignon))
Bblock
SET_ECHANTILLONNAGE_POUR_SIMULER_LES_VOINTS;
/* Mise en place d'un pas sur les trois axes compatibles avec la gestion des "voint"s. On */
/* consultera avec interet le fichier 'v $xiii/Images$DEF' a ce propos... */
BoIn(niveau_d_epluchage,NOIR,BLANC,DIVI(COULEURS,DIVI(dimZ,pasZ)))
Bblock
begin_album
Bblock
DEFV(genere_p,INIT(voint_courant,NIVEAU_UNDEF));
/* Definition du "voint" courant de la fonction de densite de l'univers. */
load_voint(voint_courant,imageR_fonction_de_densite,X,Y,Z);
/* Et recuperation de sa valeur courante. */
Test(IFGT(voint_courant,niveau_d_epluchage))
Bblock
DEFV(genere_p,INIT(niveauZ,NIVA(__DENORMALISE_NIVEAU(_____lNORMALISE_OZ(COZR(Z))))));
/* Definition intermediaire necessaire pour 'SYSTEME_SG4D..._IRIX_CC' afin que la pile de */
/* 'yacc' ne deborde pas ; elle donne le niveau a ranger en fonction de 'Z'. */
DEFV(Int,INIT(Zniveau,_cDENORMALISE_OZ(______NORMALISE_NIVEAU(niveau_d_epluchage))));
/* Definition intermediaire necessaire pour 'SYSTEME_SG4D..._IRIX_CC' afin que la pile de */
/* 'yacc' ne deborde pas ; elle donne la coordonnee 'Z' de rangement en fonction du niveau */
/* d'epluchage... */
store_voint(niveauZ
,imageR_structure_en_oignon
,X,Y,Zniveau
);
/* Sa valeur est mise a jour en fonction de la contribution locale de la galaxie courante. */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
end_album
Eblock
EBoI
Eblock
ATes
Bblock
Eblock
ETes
PULL_ECHANTILLONNAGE;
PULL_TRANSLATION;
/* Restauration de l'echantillonnage initial... */
Eblock
ATes
Bblock
PRINT_ERREUR("le fichier contenant le catalogue des galaxies est inaccessible");
Eblock
ETes
EDEFV(imageF,fonction_de_densite_de_l_univers);
/* Matrice dans laquelle on va situer les "voint"s simulant l'univers. Chaque galaxie y */
/* est materialisee par un "blob" gaussien, les "blob"s de galaxies voisines se melangeant */
/* entre eux... */
EDEFV(imageF,vue_des_galaxies_de_l_univers);
/* Matrice dans laquelle on va situer les "voint"s simulant l'univers. Chaque galaxie y */
/* est materialisee par point de couleur fonction de sa magnitude... */
RETU_ERROR;
Eblock
EFonctionI
#undef SIGMA_DE_L_EXPONENTIELLE_AU_CARRE
#undef VALEUR_DE_L_EXPONENTIELLE_AU_BORD_DE_LA_BOITE
#undef CARRE_DU_RAYON_DE_LA_BOITE
#undef LIMITE_DE_LA_BOITE_DE_LISSAGE
#undef DEMI_DIMENSION_DE_LA_BOITE_DE_LISSAGE
#undef FONCTION_DE_LISSAGE
#undef NORMALISATION_DES_COORDONNEES_DES_GALAXIES
_______________________________________________________________________________________________________________________________________