$$$$ @VECOUL
* @VECOUL   PROCEDUR  GOUNAND   13/01/22    21:15:08     7678           
************************************************************************
*  Procedure 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
*  'VIOL' 'AZUR' 'BLEU' 'TURQ' 'OCEA' 'VERT' 'OLIV' 'JAUN' 'ORAN' 'ROUG' 
*  qui correspondent a 10 intervalles de la plage de la norme 
*  (échelle linéaire dans le sens croissant).
*
*  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 ;
*'LISTE' lpas ;
*
* Table des couleurs de la norme 
* de la valeur mini (Violet) a la valeur maxi (Rouge)
TAB1     = 'TABLE' ;
TAB1 . 1 = 'MOT' 'VIOL' ;
TAB1 . 2 = 'MOT' 'AZUR' ;
TAB1 . 3 = 'MOT' 'BLEU' ;
TAB1 . 4 = 'MOT' 'TURQ' ;
TAB1 . 5 = 'MOT' 'OCEA' ;
TAB1 . 6 = 'MOT' 'VERT' ;
TAB1 . 7 = 'MOT' 'OLIV' ;
TAB1 . 8 = 'MOT' 'JAUN' ;
TAB1 . 9 = 'MOT' 'ORAN' ;
TAB1 . 10 = 'MOT' 'ROUG' ;
*
* Réduction éventuelle du champ
*
geop1 = 'EXTRAIRE' N1 'MAIL' ;
nnoe = 'NBEL' geop1 ;
*debug 'MESSAGE' ('CHAINE' 'nbno=' nnoe) ;   
'SI' lred ;
   'SI' ('<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 ;
   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 TAB1.INDI1
    VCW1 = 'VECT' CHM2 AMPL1 LIST2 (TAB1 . INDI1) ;
* Assemblage vecteur total
    VCTOT1 = VCTOT1 ET VCW1 ;
'FIN' BOU1 ;
*debug 'MESSAGE' ('CHAINE' 'nnotot=' nnotot) ;
'SI' ('NEG' nnotot nred) ;
   'ERREUR' 5 ;
'FINSI' ;   
*
'FINPROC' VCTOT1 ;