Procédures | Cast3M

* @VECOUL   PROCEDUR  FD218221  26/10/13    21:15:05     12667          
************************************************************************
*  Procédure qui construit un objet VCTOT1 (type VECTEUR)
*  de couleur variable en fonction de sa norme
*  à partir d'un champs de vecteur CH1 (type CHPOINT).
*
*  L'objet VCTOT1 est constitué de 10 sous-vecteurs de couleurs
*  qui correspondent a 10 intervalles de la plage de la norme
*  (échelle linéaire dans le sens croissant) en suivant la palette
*  de couleur définie dans OPTI 'PALE'.
*
*  Les composantes des sous-vecteurs de couleurs sont renommées pour
*  permettre l'affichage de la valeur moyenne de la norme du vecteur
*  associée à sa couleur lors du tracé graphique.
*
*  Il est possible d'extraire un pourcentage (VRED1 x 100) %
*  (si VRED1 dans [0,1]) ou un nombre donné VRED1  (si VRED1 > 1) de ces
*  vecteurs : aléatoirement si MOT1 = ALTR, régulièrement sinon.
*
*  Postraitement TRAC VCTOT1 MAILLAGE ;
*
*  Syntaxe :
*  ---------
*            VCTOT1 = @VECOUL CH1 AMPL1 CH1  (LMOT1) (MOT1) (VRED1) ;
*
*  Entrée  :
*  ---------
*    CH1      : Champs de vecteur (type CHPOINT)
*    AMPL1    : Facteur d'amplification (FLOTTANT) OBLIGATOIRE
*    LMOT1    : Préciser les noms de composantes voulues (type LISTMOTS)
*    MOT1     : Extraction aléatoire si MOT1 = ALTR, régulière sinon
*    VRED1    : Pourcentage ([0,1]) ou nombre (>1) de vecteurs
*               extraits (type FLOTTANT)
*
*  Sortie  :
*  ---------
*    VCTOT1   : Vecteur (VECTEUR) composé de 10 sous-type vecteur de
*               différentes couleurs.
*
************************************************************************
* Remarques :
*        -  Le facteur d'amplification AMPL1 est une entrée obligatoire
*        -  Si VRED1 < 0., on extrait 100 %
*        -  Extraire un faible pourcentage sur un petit nombre de
*            vecteurs peut fournir un résultat vide avec l'option
*            aléatoire (MOT1 = ALTR) alors qu'au moins 1 vecteurs par
*            couleur est extrait avec l'option régulière (gounand:
*            cette dernière remarque n'est plus valable.
* 03/12/2012 : recodage et améliorations robustesse par S. Gounand
*              ajout LMOT1 et possibilité de donner le nombre de
*              vecteurs voulus, à la place du pourcentage.
************************************************************************
'DEBPROC' @VECOUL CH1*'CHPOINT' AMPL1*'FLOTTANT' ;
VDIM = 'VALEUR' 'DIME' ;
'SI' ('NON' ('DANS' ('LECT' VDIM) ('LECT' 2 3))) ;
   CHERR  = 'CHAINE' 'This procedure only works in 2 or 3 dimensions' ;
   'ERREUR' CHERR ;
'FINSI' ;
* Lecture des noms de composantes comme pour l'opérateur VECT
'ARGUMENT' LMOT1/'LISTMOTS' ;
llmot = 'EXISTE' LMOT1 ;
'SI' llmot ;
   vmot = 'DIME' LMOT1 ;
   'SI' ('NEG' VMOT VDIM) ;
      CHERR = 'CHAINE' 'The given LISTMOTS is not of dimension ' VDIM ;
      'ERREUR' CHERR ;
   'FINSI' ;
'FINSI' ;
*
'ARGUMENT' MOT1/'MOT' VRED1/'FLOTTANT' ;
* Tests lecture MOT1 et VRED1
* Sinon options par defaut
LRED = 'EXISTE' VRED1 ;
'SI' LRED ;
* Vérif
   LRED = ('>EG' VRED1 0.) ;
'FINSI' ;
LALEA = 'EGA' MOT1 'ALTR' ;
* Extraction des noms des composantes de CH1 (2D ou 3D)
'SI' LLMOT ;
   LICP1 = LMOT1 ;
'SINON' ;
*  Problème potentiel si CH1 contient d'autres composantes que celles
*  de vitesses
   LICP1 = 'EXTRAIRE' CH1 'COMP' ;
   VLICP1 = 'DIME' LICP1 ;
   'SI' ('NEG' VLICP1 VDIM) ;
      CHERR = 'CHAINE'
      'The given CHPOINT hasnt got ' VDIM ' component names.' ;
      'LISTE' LICP1 ;
      'ERREUR' CHERR ;
   'FINSI' ;
'FINSI' ;
* Calcul de la norme
N2 = 'PSCA' CH1 CH1 LICP1 LICP1 ;
N1 = '**' N2 0.5 ;
* Extraction min max de la norme
MINI1 = 'MINI' N1 ;
MAXI1 = 'MAXI' N1 ;
* Pas de decoupage de la norme pour les couleurs (10)
* Attention si MINI1=MAXI1 LPAS ne sera que de dimension 2...
DNN1 = (MAXI1 '-' MINI1) '/' 10.D0 ;
LPAS = 'PROG' MINI1 'PAS' DNN1 MAXI1 ;
* Codes RVB des couleurs de l'operateur COUL (normalises entre 0. et 1.)
LCOUL = 'MOTS' 'BLEU' 'ROUG' 'ROSE' 'VERT' 'TURQ' 'JAUN' 'BLAN' 'NOIR' 'VIOL' 'ORAN'
               'AZUR' 'OCEA' 'CYAN' 'OLIV' 'GRIS' 'POUR' 'BRUN' 'BRIQ' 'CORA' 'BEIG'
               'OR  ' 'MARI' 'BOUT' 'LIME' 'LAVA' 'BRON' 'KAKI' 'PEAU' 'CARA' 'INDI' ;
LROUGE = 'PROG' 0.0000 1.0000 1.0000 0.0000 0.0000 1.0000 1.0000 0.0000 0.5804 1.0000
                0.1176 0.2353 0.5294 0.6039 0.7450 0.8157 0.5451 0.6980 1.0000 0.9607
                1.0000 0.0000 0.0000 0.5000 0.9019 0.8549 0.9411 1.0000 0.8039 0.2941 ;
LVERT  = 'PROG' 0.0000 0.0000 0.0000 1.0000 0.8078 1.0000 1.0000 0.0000 0.0000 0.6471
                0.5647 0.7020 0.8078 0.8039 0.7450 0.1255 0.2706 0.1333 0.5000 0.8706
                0.8431 0.0000 0.3921 1.0000 0.9019 0.6470 0.9019 0.7137 0.5215 0.0000 ;
LBLEU  = 'PROG' 1.0000 0.0000 1.0000 0.0000 0.8196 0.0000 1.0000 0.0000 0.8274 0.0000
                1.0000 0.4431 0.9804 0.1961 0.7450 0.5647 0.0745 0.1333 0.3137 0.7019
                0.0000 0.5000 0.0000 0.0000 0.9803 0.1254 0.5490 0.7568 0.2470 0.5882 ;
* Liste des 10 couleurs de la norme (selon VALE 'PALE')
PAL1  = 'VALE' 'PALE' ;
* Preconditionnement si palette par defaut :
PALD  = 'PALE' 'DEFA' ;
A B C = 'MAXI' (PAL1 - PALD) ;
'SI' (('MAXI' ('MAXI' B) ('MAXI' C)) '<' 1.E-9) ;
  LCOU   = 'MOTS' 'BLEU' 'AZUR' 'TURQ' 'OCEA' 'OLIV' 'VERT' 'OR' 'ORAN' 'CORA' 'ROUG' ;
* Sinon, interpolation de 10 couleurs dans la palette
'SINON' ;
   LVAL  = 'PROG' 0. 'PAS' (1. '/' 9) 1. ;
   LCOU  = 'MOTS' ;
   LRPAL = 'EXTR' PAL1 'COUR' 1 ;
   LVPAL = 'EXTR' PAL1 'COUR' 2 ;
   LBPAL = 'EXTR' PAL1 'COUR' 3 ;
   'REPE' B1 ('DIME' LVAL) ;
   VAL1     = 'EXTR' LVAL &B1 ;
   X1       = 'IPOL' VAL1 LRPAL ;
   Y1       = 'IPOL' VAL1 LVPAL ;
   Z1       = 'IPOL' VAL1 LBPAL ;
   DIS1  = 'VALE' 'GRAN' ;
   POS1     = -1 ;
   'REPE' B2 ('DIME' LCOUL) ;
      X2     = 'EXTR' LROUGE &B2 ;
      Y2     = 'EXTR' LVERT  &B2 ;
      Z2     = 'EXTR' LBLEU  &B2 ;
      LS1 AS1 BS1 = CIELAB X1 Y1 Z1 ;
      LS2 AS2 BS2 = CIELAB X2 Y2 Z2 ;
      DIS2   = ((LS1 '-' LS2) '**' 2) '+' ((AS1 '-' AS2) '**' 2) '+' ((BS1 '-' BS2) '**' 2) ;
      'SI' (DIS2 < DIS1) ;
         DIS1   = DIS2 ;
         POS1   = &B2 ;
      'FINSI' ;
   'FIN' B2 ;
   COUL1   = 'EXTR' LCOUL POS1 ;
   LCOU    = LCOU 'ET' COUL1 ;
   'FIN' B1 ;
'FINSI' ;
*
* Réduction éventuelle du champ
*
GEOP1 = 'EXTRAIRE' N1 'MAIL' ;
NNOE = 'NBEL' GEOP1 ;
*debug 'MESSAGE' ('CHAINE' 'nbno=' nnoe) ;
'SI' LRED ;
   'SI' ('&lt;EG' VRED1 1.5D0) ;
      NNCIB = 'ENTIER' ('+' ('*' NNOE VRED1) 0.5) ;
   'SINON' ;
      NNCIB = 'ENTIER' ('+' VRED1 0.5) ;
   'FINSI' ;
*debug 'MESSAGE' ('CHAINE' 'nbno cible=' nncib) ;
   NNCIB = 'MINIMUM' ('LECT' NNOE NNCIB) ;
   VRED1F = '/' ('FLOTTANT' NNCIB) ('FLOTTANT' NNOE) ;
*debug 'MESSAGE' ('CHAINE' 'VRED1F=' VRED1F) ;
   'SI' LALEA ;
      RESU1 = 'BRUI' 'BLAN' 'UNIF' 0.5 0.5 GEOP1 ;
      GEOP1 = 'POINT' RESU1 'EGSUPE' ('-' 1. VRED1F) ;
   'SINON' ;
      VPAS   = '/' ('FLOTTANT' NNOE) ('FLOTTANT' NNCIB) ;
      LELEM1 = 'ENTIER' ('PROG' 1.5 'PAS' VPAS 'NPAS' ('-' NNCIB 1)) ;
      GEOP1 = 'ELEM' GEOP1 LELEM1 ;
   'FINSI' ;
   N1   = 'REDU' N1 GEOP1 ;
   CH1  = 'REDU' CH1 GEOP1 ;
'FINSI' ;
NRED = 'NBEL' GEOP1 ;
*debug 'MESSAGE' ('CHAINE' 'nbno apres red=' nred) ;
*
VCTOT1 = 'VIDE' 'VECTEUR' ;
NNOTOT = 0 ;
* Boucle de decoupage  (10 couleurs ou 2 si MAXI1=MINI1)
*NBOU1 = 10 ;
NBOU1 = '-' ('DIME' LPAS) 1 ;
'REPETER' BOU1 NBOU1 ;
   INDI1 = &BOU1 ;
   COU1 = 'EXTRAIRE' LCOU INDI1 ;
   BAS1 = 'EXTRAIRE' LPAS INDI1 ;
   SUP1 = 'EXTRAIRE' LPAS ('+' INDI1 1) ;
   MAILN1 = 'EXTRAIRE' N1 'MAIL' ;
   MAIL1  = 'POIN' N1 'EGINFE' SUP1 ;
   NMAIL1 = 'NBEL' MAIL1 ;
*debug 'MESSAGE' ('CHAINE' 'nbno bou1=' INDI1 ' mail1=' nmail1) ;
   NNOTOT = '+' NNOTOT NMAIL1 ;
   MRED = 'DIFF' MAIL1 MAILN1 ;
   N1 = 'REDU' N1 MRED ;
* Norme moyenne de la couleur pour trace
   MOY1 = (SUP1 + BAS1) * 0.5D0 ;
* Extraction de la valeur de la norme (sans exposant) pour trace
   FMOY1 = 'CHAIN' 'FORMAT' '(1PE8.2)' MOY1 ;
   FMOY1_1 = 'EXTRAIRE' FMOY1 1 4 ;
   FMOY1_2 = 'EXTRAIRE' FMOY1 5 8 ;
   CHM1 = 'REDU' CH1 MAIL1 ;
* Changement du nom des composantes pour afficher la valeur de la norme
   'SI' ('EGA' vdim 3) ;
      LIST2 = 'MOTS' fMOY1_1 fMOY1_2 '  ' ;
   'SINON' ;
      LIST2 = 'MOTS' fMOY1_1 fMOY1_2 ;
    'FINSI' ;
    CHM2 = 'NOMC' LICP1 LIST2 CHM1  ;
* Fabrication vecteur élémentaire de couleur COU1
    VCW1 = 'VECT' CHM2 AMPL1 LIST2 COU1 ;
* Assemblage vecteur total
    VCTOT1 = VCTOT1 'ET' VCW1 ;
'FIN' BOU1 ;
*debug 'MESSAGE' ('CHAINE' 'nnotot=' nnotot) ;
'SI' ('NEG' NNOTOT NRED) ;
   'ERREUR' 5 ;
'FINSI' ;
*
'FINPROC' VCTOT1 ;