/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        D E F I N I T I O N   D E S   H A R M O N I Q U E S   S P H E R I Q U E S  :                                               */
/*                                                                                                                                   */
/*                                                                                                                                   */
/*        Author of '$xrq/Hspherik.11$K' :                                                                                           */
/*                                                                                                                                   */
/*                    Jean-Francois COLONNA (LACTAMME, 1993??????????).                                                              */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        I N T E R F A C E   ' listG '  :                                                                                           */
/*                                                                                                                                   */
/*                                                                                                                                   */
/*        :Debut_listG:                                                                                                              */
/*        :Fin_listG:                                                                                                                */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        D I R E C T I V E S   S P E C I F I Q U E S   D E   C O M P I L A T I O N  :                                               */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
@define   PRAGMA_CL_____MODULE_NON_OPTIMISABLE

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        F I C H I E R S   D ' I N C L U D E S  :                                                                                   */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  INCLUDES_BASE
#include  image_image_IMAGESF_EXT
                                        /* Introduit le 20061210113318 pour 'v $xrs/surfaces.12$I IFmageA4'...                       */

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        D E F I N I T I O N S   D E   B A S E   E T   U N I V E R S E L L E S  :                                                   */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrk/attractor.11.I"
#include  xrv/particule.41.I"

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*                                                                                    3                                              */
/*        D E F I N I T I O N   D E   L ' E S P A C E   P H Y S I Q U E   D A N S   R     ( D E B U T )  :                           */
/*                                                                                                                                   */
/*                                                                                                                                   */
/*        Nota :                                                                                                                     */
/*                                                                                                                                   */
/*                    Les extrema des coordonnees {x,y,z}                                                                            */
/*                  ainsi que ceux de leurs differentielles                                                                          */
/*                  {dx,dy,dz} sont fixees un peu arbitrairement                                                                     */
/*                  et sans etre parametrees.                                                                                        */
/*                                                                                                                                   */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrs/sphere.18.I"
                                        /* Introduit le 20030130110509 a cause de 'v $xcc/cpp$Z INCLUDES_1.sed'.                     */

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*                                                                                    3                                              */
/*        D E F I N I T I O N   D E   L ' E S P A C E   P H Y S I Q U E   D A N S   R     ( D E B U T )  :                           */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrk/attractor.12.I"

#include  xrs/sphere.19.I"
                                        /* Introduit le 20030130110509 a cause de 'v $xcc/cpp$Z INCLUDES_1.sed'.                     */

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        D E F I N I T I O N   D ' U N E   S P H E R E  :                                                                           */
/*                                                                                                                                   */
/*                                                                                                                                   */
/*        Definition :                                                                                                               */
/*                                                                                                                                   */
/*                    Elle est definie parametriquement                                                                              */
/*                  en fonction des deux parametres 'u'                                                                              */
/*                  et 'v' :                                                                                                         */
/*                                                                                                                                   */
/*                                      F (u,v) = r.cos(u).cos(v)                                                                    */
/*                                       x                                                                                           */
/*                                                                                                                                   */
/*                                      F (u,v) = r.cos(u).sin(v)                                                                    */
/*                                       y                                                                                           */
/*                                                                                                                                   */
/*                                      F (u,v) = r.sin(u)                                                                           */
/*                                       z                                                                                           */
/*                                                                                                                                   */
/*                  avec :                                                                                                           */
/*                                                                                                                                   */
/*                                               p       p                                                                           */
/*                                      u E [ - --- , + --- ]                                                                        */
/*                                               2       2                                                                           */
/*                                                                                                                                   */
/*                                      v E [ 0 , 2.p ]                                                                              */
/*                                                                                                                                   */
/*                  (ou 'p' designe 'pi').                                                                                           */
/*                                                                                                                                   */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrs/sphere.12.I"
#include  xrq/Hspherik.14.I"
                                        /* Introduit le 20060611084752 suite a 'v $xrs/surfaces.12$I 20060602134331'.                */
#include  xrs/sphere.14.I"

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        F O N C T I O N S   D E   V I S U A L I S A T I O N   E T   D ' I N T E R P O L A T I O N  :                               */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrs/surfaces.21.I"
                                        /* A cause de 'v $xrs/surfaces.51$I definir_arbitrairement_les_coordonnees_u_et_v' ceci      */
                                        /* fut introduit le 20221224172925...                                                        */

#define   RAYON_DE_VISUALISATION                                                                                                        \
                    FRA1(FRA10(FU))                                                                                                     \
                                        /* Rayon du disque materialisant une iteration.                                              */

#include  xrq/Hspherik.15.I"

#include  xrs/surfaces.11.I"

dfTRANSFORMAT_31(liste_PARAMETRE_R,fichier_PARAMETRE_R,PARAMETRE_R_IMPLICITE,PARAMETRE_R)
                                        /* Definition du fichier du parametre 'r'.                                                   */

#define   sPARAMETRE_R(numero_de_la_periode)                                                                                            \
                    FLOT(sTRANSFORMAT_31(numero_de_la_periode,liste_PARAMETRE_R))
                                        /* Formule generale definissant les variations de 'r' au cours du temps.                     */

#define   COLORIER_AVEC_L_HARMONIQUE_SPHERIQUE                                                                                          \
                    FAUX
DEFV(Local,DEFV(Logical,INIT(colorier_avec_l_harmonique_spherique,COLORIER_AVEC_L_HARMONIQUE_SPHERIQUE)));
                                        /* Indique si le coloriage, lorsque l'on est en mode 'RVB' se fait a l'aide de l'harmonique  */
                                        /* spherique ('VRAI') auquel cas le rayon des spheres est constant, ou bien a l'aide des     */
                                        /* differentielles sur la sphere ('FAUX') auquel cas le rayon des spheres est alors a        */
                                        /* l'harmonique spherique...                                                                 */

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        D E F I N I T I O N   D E S   T R O I S   F O N C T I O N S   ' F '  :                                                     */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrs/sphere.11.I"
                                        /* ATTENTION, il est imperatif que les fonctions derivables formellement soient definies     */
                                        /* dans un fichier a part afin qu'elles ne soient pas l'objet d'une double definition. En    */
                                        /* effet, on trouve dans 'v $xcc/cpp$Z' :                                                    */
                                        /*                                                                                           */
                                        /*                  $CA  $module$w                                                           */
                                        /*                                 | $xcp/cpp$X          ... -c$PASSE_D -e$PASSE_5           */
                                        /*                                                                              > $fichierR  */
                                        /*                                                                                           */
                                        /* Ainsi, si par exemple la definition de 'RAYON(h,theta)' etait faite localement dans le    */
                                        /* fichier '$xrf/recursif.11$K', cette definition apparaitrait deux fois dans le fichier     */
                                        /* '$module$w' : une premiere fois en tete, provenant de '$PASSE_D' ou l'on ne trouve que    */
                                        /* les definitions du type '-define ...', puis une deuxieme fois a la suite, la ou se trouve */
                                        /* concatene au fichier '$module$W' des '-define ...' le fichier '$fichierA' a compiler...   */

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        D E F I N I T I O N   D E S   H A R M O N I Q U E S   S P H E R I Q U E S  :                                               */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrq/Legendre.11.I"
#include  xrq/Hspherik.11.I"
#include  xrq/Hspherik.12.I"

#define   ORDRE_l                                                                                                                       \
                    ORDRE_l_00
DEFV(Local,DEFV(Int,INIT(ordre_l,ORDRE_l)));
                                        /* Definition de l'ordre 'l'.                                                                */
#define   ORDRE_m                                                                                                                       \
                    ORDRE_m_00
DEFV(Local,DEFV(Int,INIT(ordre_m,ORDRE_m)));
                                        /* Definition de l'ordre 'm'.                                                                */

DEFV(Local,DEFV(Float,INIT(rayon_de_visualisation_de_base,FLOT__UNDEF)));
                                        /* Rayon de visualisation de base qui sera module par les harmoniques spheriques...          */

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        P O U R   D E S   R A I S O N S   D E   C O M P A T I B I L I T E  :                                                       */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrk/integr.1B.vv.I"

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        D E F I N I T I O N   D E S   I N I T I A L I S A T I O N S  :                                                             */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrk/attractor.18.I"

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        C H O I X   D E   C E   Q U I   S E R A   V I S U A L I S E  :                                                             */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrv/champs_5.1B.I"

#define   CALCULER_AUSSI_LA_PARTIE_IMAGINAIRE                                                                                           \
                    VRAI
DEFV(Local,DEFV(Logical,INIT(calculer_aussi_la_partie_Imaginaire,CALCULER_AUSSI_LA_PARTIE_IMAGINAIRE)));
                                        /* Faut-il calculer la partie Imaginaire :                                                   */
                                        /*                                                                                           */
                                        /* VRAI : c'est le module de l'harmonique spherique qui sera visualisee,                     */
                                        /* FAUX : c'est uniquement la partie Reelle de l'harmonique spherique qui sera visualisee.   */
                                        /*                                                                                           */

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        P R O C E D U R E S   U T I L E S  :                                                                                       */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
#include  xrq/Hspherik.13.I"

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        D E F I N I T I O N   D E S   H A R M O N I Q U E S   S P H E R I Q U E S  :                                               */
/*                                                                                                                                   */
/*************************************************************************************************************************************/
BCommande(nombre_d_arguments,arguments)
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
#include  xrs/surfaces.41.I"
                                        /* Introduit le 20161206103619...                                                            */

#include  xrs/surfaces.22.I"
                                        /* Introduit le 20221224172925...                                                            */
     /*..............................................................................................................................*/
     INITIALISATIONS_GENERALES;
                                        /* Initialisations generales faites au tout debut...                                         */

     iTRANSFORMAT_31(liste_PARAMETRE_R,PARAMETRE_R_IMPLICITE);
                                        /* Initialisation du parametre 'r'.                                                          */

#include  xrv/champs_5.1A.I"
#include  xrs/surfaces.13.I"

     GET_ARGUMENTSv(nombre_d_arguments
                   ,BLOC(PROCESS_ARGUMENTS_GEOMETRIQUES;

                         PROCESS_ARGUMENT_FICHIER("PARAMETRE_R="
                                                 ,fichier_PARAMETRE_R
                                                 ,liste_PARAMETRE_R
                                                 ,PARAMETRE_R_IMPLICITE
                                                 ,gTRANSFORMAT_31
                                                  );

                         PROCESS_ARGUMENTS_DE_VISUALISATION;
                         PROCESS_ARGUMENTS_DE_DEFINITION_DU_RAYON_DES_SPHERES_REPRESENTATIVES;

                         GET_ARGUMENT_I("ordre_l=""l=",ordre_l);
                         GET_ARGUMENT_I("ordre_m=""m=",ordre_m);

                         GET_ARGUMENT_L("harmonique=",colorier_avec_l_harmonique_spherique);

                         GET_ARGUMENT_L("imaginaire=",calculer_aussi_la_partie_Imaginaire);

                         PROCESS_ARGUMENTS_DE_DEFINITION_DES_COORDONNEES_CURVILIGNES;
                         )
                    );

     Test(IFGT(ordre_m,ordre_l))
          Bblock
          PRINT_ERREUR("l'ordre 'm' est superieur a l'ordre 'l', il prend une valeur egale a celle de 'l'");
          EGAL(ordre_m,ordre_l);
          Eblock
     ATes
          Bblock
          Eblock
     ETes

     EGAL(rayon_de_visualisation_de_base,rayon_de_visualisation);
                                        /* Rayon de visualisation de base qui sera module par les harmoniques spheriques. On notera  */
                                        /* que pour se simplifier la vie on prend pour 'rayon_de_visualisation_de_base' la valeur du */
                                        /* parametre interactif 'rayon_de_visualisation'...                                          */

#include  xrs/surfaces.12.I"
                                        /* Visualisation et evolution de la surface au cours du temps...                             */

#define   harmonique_spherique_2                                                                                                        \
                    Cmodule2(harmonique_spherique)                                                                                      \
                                        /* Pour reduire la longueur de certaines lignes...                                           */

     VISUALISATION_DE_LA_SURFACE_AVEC_DIFFERENTIATION(BLOC(EGAL(parametre_r,sPARAMETRE_R(numero_de_la_periode_courante));
                                                           )
                                        /* Calcul de la valeur du parametre 'r'.                                                     */
                                                     ,Fx_Sphere_1,Fy_Sphere_1,Fz_Sphere_1
                                        /* Fonctions definissant parametriquement la surface...                                      */
                                                     ,BLOC(Bblock
                                                           DEFV(complexe,harmonique_spherique);
                                        /* Definition des parties Reelle et Imaginaire des Harmoniques Spheriques.                   */
                                                           Choi(ordre_l)
                                                                Bblock
                                                                Ca1e(ORDRE_l_00)
                                                                     Bblock
                                                                     Choi(ordre_m)
                                                                          Bblock
                                                                          CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_00,ORDRE_m_00);
                                                                          Defo
                                                                               Bblock
                                                                               PRINT_ERREUR("ordre 'm' demande non implemente");
                                                                               Eblock
                                                                          EDef
                                                                          Eblock
                                                                     ECho
                                                                     Eblock
                                                                ECa1

                                                                Ca1e(ORDRE_l_01)
                                                                     Bblock
                                                                     Choi(ordre_m)
                                                                          Bblock
                                                                          CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_01,ORDRE_m_00);
                                                                          CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_01,ORDRE_m_01);

                                                                          Defo
                                                                               Bblock
                                                                               PRINT_ERREUR("ordre 'm' demande non implemente");
                                                                               Eblock
                                                                          EDef
                                                                          Eblock
                                                                     ECho
                                                                     Eblock
                                                                ECa1

                                                                Ca1e(ORDRE_l_02)
                                                                     Bblock
                                                                     Choi(ordre_m)
                                                                          Bblock
                                                                          CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_02,ORDRE_m_00);
                                                                          CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_02,ORDRE_m_01);
                                        /* ATTENTION : pour ne pas allourdir le pre-processing, on ne met pas :                      */
                                        /*                                                                                           */
                                        /*                  CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_02,ORDRE_m_02);                */
                                        /*                                                                                           */
                                        /* et ce afin d'eviter des erreurs du type :                                                 */
                                        /*                                                                                           */
                                        /*                  Error :: ...: ...: EGAL: actuals too long                                */
                                        /*                                                                                           */

                                                                          Defo
                                                                               Bblock
                                                                               PRINT_ERREUR("ordre 'm' demande non implemente");
                                                                               Eblock
                                                                          EDef
                                                                          Eblock
                                                                     ECho
                                                                     Eblock
                                                                ECa1

                                                                Ca1e(ORDRE_l_03)
                                                                     Bblock
                                                                     Choi(ordre_m)
                                                                          Bblock
                                                                          CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_03,ORDRE_m_00);
                                        /* ATTENTION : pour ne pas allourdir le pre-processing, on ne met pas :                      */
                                        /*                                                                                           */
                                        /*                  CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_03,ORDRE_m_01);                */
                                        /*                  CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_03,ORDRE_m_02);                */
                                        /*                  CALCUL_D_UNE_HARMONIQUE_SPHERIQUE(ORDRE_l_03,ORDRE_m_03);                */
                                        /*                                                                                           */
                                        /* et ce afin d'eviter des erreurs du type :                                                 */
                                        /*                                                                                           */
                                        /*                  Error :: ...: ...: EGAL: actuals too long                                */
                                        /*                                                                                           */

                                                                          Defo
                                                                               Bblock
                                                                               PRINT_ERREUR("ordre 'm' demande non implemente");
                                                                               Eblock
                                                                          EDef
                                                                          Eblock
                                                                     ECho
                                                                     Eblock
                                                                ECa1

                                                                Defo
                                                                     Bblock
                                                                     PRINT_ERREUR("ordre 'l' demande non implemente");
                                                                     Eblock
                                                                EDef
                                                                Eblock
                                                           ECho

                                                           Test(IFET(IL_FAUT(visualiser_en_RVB)
                                                                    ,IL_FAUT(colorier_avec_l_harmonique_spherique)
                                                                     )
                                                                )
                                                                Bblock
                                                                DEFV(Float,INIT(harmonique_spherique_au_carre
                                                                               ,TRON(harmonique_spherique_2
                                                                                    ,COORDONNEE_BARYCENTRIQUE_MINIMALE
                                                                                    ,COORDONNEE_BARYCENTRIQUE_MAXIMALE
                                                                                     )
                                                                                )
                                                                     );
                                        /* L'harmonique spherique au carre va servir de coordonnee barycentrique...                  */

                                                                EGAL(dcx
                                                                    ,BARY(______________NOIR_NORMALISE
                                                                         ,______________BLANC_NORMALISE
                                                                         ,harmonique_spherique_au_carre
                                                                          )
                                                                     );
                                                                EGAL(dcy
                                                                    ,______NORMALISE_NIVEAU(GRIS_2)
                                                                     );
                                                                EGAL(dcz
                                                                    ,BARY(______________BLANC_NORMALISE
                                                                         ,______________NOIR_NORMALISE
                                                                         ,harmonique_spherique_au_carre
                                                                          )
                                                                     );
                                        /* Le choix des couleurs est fait alors de facon a ce que :                                  */
                                        /*                                                                                           */
                                        /*                  harmonique=0  ==>  BLEU,                                                 */
                                        /*                  harmonique=1  ==>  ROUGE.                                                */
                                        /*                                                                                           */

                                                                EGAL(rayon_de_visualisation
                                                                    ,rayon_de_visualisation_de_base
                                                                     );
                                        /* Le rayon de visualisation du point courant est constant lorsque le coloriage se fait      */
                                        /* avec la densite de probabilite de presence...                                             */
                                                                Eblock
                                                           ATes
                                                                Bblock
                                                                EGAL(rayon_de_visualisation
                                                                    ,MUL2(RAYON_DES_SPHERES_REPRESENTATIVES(FU
                                                                                                           ,harmonique_spherique_2
                                                                                                            )
                                                                         ,rayon_de_visualisation_de_base
                                                                          )
                                                                     );
                                        /* Le rayon de visualisation du point courant est proportionnel au module de l'harmonique    */
                                        /* spherique locale eleve a une certaine puissance...                                        */
                                                                Eblock
                                                           ETes

                                                           LIMITATION_DU_RAYON_DE_VISUALISATION;
                                        /* Et on fait en sorte qu'il ne soit pas trop petit...                                       */
                                                           Eblock
                                                           )
                                        /* Calcul des harmoniques spheriques...                                                      */
                                                     ,BLOC(VIDE;)
                                        /* Introduit le 20061210112111 car il manquait...                                            */
                                                      );

     EDITION_DES_DEBORDEMENTS_DU_RAYON_DE_VISUALISATION;

     RETU_Commande;
     Eblock
ECommande



Copyright © Jean-François COLONNA, 2019-2024.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2019-2024.