Télécharger matoutil.procedur

Retour à la liste

* MATOUTIL  PROCEDUR  GOUNAND   26/07/06    21:15:06     12592          
************************************************************************
* NOM         : MATOUTIL
* DESCRIPTION : Procédures utilitaires utilisées par la procédure
*               MAILTOPO
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
*               mail : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 08/04/2021, version initiale
* HISTORIQUE : v1, 08/04/2021, creation
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
'DEBPROC' MATOUTIL ;
'ARGUMENT' motcle*'MOT' ;
*
lmotcle = 'MOTS' 'GASTIDX' 'GENTABIN' 'VERTABIN' 'MESUINTE' 'AFFQUAL'
   'BORD' 'FERMEPZ' 'OUVREPZ' 'MOYECHAM' 'AFFCAND' 'MAILINTE' 'VERITOPO' ;
'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
   'ERREUR' 1052 'AVEC' motcle
'GASTIDX GENTABIN VERTABIN MESUINTE AFFQUAL BORD FERMEPZ OUVREPZ MOYECHAM AFFCAND MAILINTE VERITOPO' ;
'FINSI' ;
*
'SI' ('EGA' motcle 'GASTIDX') ;
************************************************************************
* NOM         : GASTIDX
* DESCRIPTION : Get and set table index
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 08/12/2017, version initiale
* HISTORIQUE : v1, 08/12/2017, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*'DEBPROC' GASTIDX ;
'ARGU' tab*'TABLE' ;
'ARGUMENT' idx*'MOT' ;
'ARGU' valdef ;
*
valdefd = 'EXIS' valdef ;
idxd    = 'EXIS' tab idx ;
setd    = valdefd 'ET' ('NON' idxd) ;
*
*debug = 'VALE' debu  ;
*
'SI' setd ;
   tab . idx = valdef ;
'FINS' ;
val = tab . idx ;
*
'SI' faux ;
   tval = 'TYPE' val ;
   'SI' (('EGA' tval 'ENTIER') 'OU' ('EGA' tval 'FLOTTANT') 'OU' ('EGA'
      tval 'MOT') 'OU' ('EGA' tval 'LOGIQUE')) ;
      mval = val ;
   'SINO' ;
      mval = 'CHAI' '*' tval ;
   'FINS' ;
   ch = 'CHAI' 'tab . ' idx*20 '='/21 mval*40 ;
   'SI' setd ;
      ch = 'CHAI' ch '(defaut)'*60 ;
   'FINS' ;
   'MESS' ch ;
'FINS' ;
*
'RESPRO' val ;
*
* End of procedure file GASTIDX
*
'FINSI' ;
'SI' ('EGA' motcle 'GENTABIN') ;
*$$$$ GENTABIN
************************************************************************
* NOM         : GENTABIN
* DESCRIPTION : Construit une table dont les indices sont les mots
*               donnés en entrée.
*               Cette table sert ensuite dans VERTABIN pour vérifier
*               que tous les indices d'une autre table ne sont pas
*               différents de ceux de la première
*
*               C'est un peu l'équivalent de MOTS et EXIS tab LISTMOTS
*               pour des mots de taille quelconque.
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stephane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
*               mail : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 14/04/2020, version initiale
* HISTORIQUE : v1, 14/04/2020, creation
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*'DEBPROC' GENTABIN ;
'ARGUMENT' tabin/'TABLE' ;
'SI' ('NON' ('EXIS' tabin)) ;
   tabin = 'TABL' ;
'FINS' ;
'REPE' bcl ;
   'ARGU' titi/'MOT' ;
   'SI' ('EXIS' titi) ;
*dbg      'MESS' 'gentabin titi' ' ' titi ;
      tabin . titi = vrai ;
   'SINO' ;
      'QUIT' bcl ;
   'FINS' ;
'FIN' bcl ;
'RESPRO' tabin ;
*
* End of procedure file GENTABIN
*
*'FINPROC' ;
'FINS' ;
*
'SI' ('EGA' motcle 'VERTABIN') ;
************************************************************************
* NOM         : VERTABIN
* DESCRIPTION : GENTABIN a construit une table dont les indices sont les
*               mots donnés en entrée.
*               Cette table sert ensuite dans VERTABIN pour vérifier
*               que tous les indices d'une autre table ne sont pas
*               différents de ceux de la première
*
*               C'est un peu l'équivalent de MOTS et EXIS tab LISTMOTS
*               pour des mots de taille quelconque.
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stephane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
*               mail : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 14/04/2020, version initiale
* HISTORIQUE : v1, 14/04/2020, creation
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*'DEBPROC' VERTABIN ;
'ARGU' tverif*'TABLE' ;
'ARGU' tabin*'TABLE' ;
tlicit = 'INDE' tverif ;
*dbg 'LIST' tlicit ;
dtl = 'DIME' tlicit ;
'REPE' itl dtl ;
   idx = 'CHAI' tlicit . &itl ;
*dbg   'MESS' 'vertabin idx' ' ' idx ;
   'SI' ('NON' ('EXIS' tabin idx)) ;
* 791 2
*Indice %m1:8 : N'est pas un indice de table reconnu
      'ERRE' 791 'AVEC' idx ;
   'FINS' ;
'FIN' itl ;
*
* End of procedure file VERTABIN
*
*'FINPROC' ;
'FINS' ;
*
'SI' ('EGA' motcle 'MESUINTE') ;
************************************************************************
* NOM         : MESUINTE
* DESCRIPTION :
*
*
* Procédure MESUINTE qui devient MESU SURF (si dim 2) ou MESU VOLU (si dim 3)
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 25/08/2016, version initiale
* HISTORIQUE : v1, 25/08/2016, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
'ARGUMENT' mai*'MAILLAGE' ;
vdim = 'VALEUR' 'DIME' ;
'SI' ('EGA' vdim 2) ;
   vol = 'MESURE' mai 'SURF' ;
'SINON' ;
   vol = 'MESURE' mai 'VOLU' ;
'FINSI' ;
'RESPRO' vol ;
*
* End of procedure file MESUINTE
*
'FINS' ;
*
'SI' ('EGA' motcle 'AFFQUAL') ;
************************************************************************
* NOM         : AFFQUAL
* DESCRIPTION : Affiche les qualités d'un maillage
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 25/08/2016, version initiale
* HISTORIQUE : v1, 25/08/2016, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
'ARGUMENT' curtopo*'MAILLAGE' ;
'ARGU' volucib*'FLOTTANT' ;
*plus nécessaire 'ARGU' denstol*'FLOTTANT' ;
'ARGU' lcritq*'LISTREEL' ;
*
*lmet=faux ;
 
laff=vrai ;
lres=faux ;
momet = 'GEOM' ;
vprec = '*' ('VALE' 'PREC') 10.d0 ;
 
lmotcle = 'MOTS' 'VMET' 'NAFF' 'REST' 'ARIT' 'GEOM' ;
'REPETER' imotcle ;
   'ARGUMENT' motcle/'MOT' ;
   'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
*   'MESS' ('CHAI' 'affqual.proc : mot-cle lu :' motcle) ;
   'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
      cherr = 'CHAINE' 'Keyword' ' ' motcle ' unknown.' ; 'ERREUR' cherr ;
   'FINSI' ;
   'SI' ('EGA' motcle 'VMET') ;
      'ARGU' metva ;
*      'MESS' ('CHAI' 'affqual.proc : metva=') ;
*      'LIST' ('TYPE' metva);
   'FINS' ;
   'SI' ('EGA' motcle 'NAFF') ; laff=faux ; 'FINSI' ;
   'SI' ('EGA' motcle 'REST') ; lres=vrai ; 'FINSI' ;
   'SI' ('EGA' motcle 'ARIT') ; momet = motcle ; 'FINSI' ;
   'SI' ('EGA' motcle 'GEOM') ; momet = motcle ; 'FINSI' ;
'FIN' imotcle ;
*'MESS' ('CHAI' 'laff=' laff) ;
*'MESS' ('CHAI' 'lmet=' lmet) ;
*'MESS' ('CHAI' 'lres=' lres) ;
lmetva = 'EXIS' metva ;
   'SI' lmetva ;
      qtopo = 'INDI' 'TOP2' curtopo metva momet lcritq ;
   'SINO' ;
      qtopo = 'INDI' 'TOP2' curtopo lcritq ;
   'FINS' ;
*listreel   nel = 'DIME' qtopo ;
   nel = 'NBEL' curtopo ;
   nno = 'NBNO' curtopo ;
   dvol = '-' ('MESURE' curtopo) volucib ;
   cqalo = qtopo ;
   cqalog = 'CHAN' cqalo ('MODE' ('EXTR' cqalo 'MAIL') 'THERMIQUE') 'GRAVITE' ;
   cqalol = 'EXTR' qtopo 'VALE' 'TOP2' ;
   cqalol = 'ORDO' cqalol ; dcqalol = 'DIME' cqalol ;
   miq = 'EXTR' cqalol 1 ; maq = 'EXTR' cqalol dcqalol ;
   meq = 'EXTR' cqalol ('/' ('+' 1 dcqalol) 2) ;
*   miq = 'MINIMUM' qtopo ; maq = 'MAXIMUM' qtopo ;
**listreel   moq = '/' ('SOMME' qtopo) nel ;
*   moq = MATOUTIL 'MOYECHAM' qtopo ;
*! Test des deux façons de calculer !
   'SI' faux ;
      'SI' lmetva ;
         qtopo2 = 'INDI' 'TOP2' curtopo metva momet 'LISTREEL' lcritq ;
      'SINO' ;
         qtopo2 = 'INDI' 'TOP2' curtopo 'LISTREEL' lcritq ;
      'FINS' ;
      cqalo2 = 'ORDO' qtopo2 ; dcqalo2 = 'DIME' cqalo2 ;
      meq2 = 'EXTR' cqalo2 ('/' ('+' 1 dcqalo2) 2) ;
*   moq2 = ('SOMM' qtopo2) '/' ('DIME' qtopo2) ;
* VALE prec un peu trop serré pour semt2
      'SI' ('NEG' meq meq2 vprec) ;
        'MESS' 'meq,meq2,dmeq' meq meq2 ('-' meq meq2) ;
      'FINS' ;
   'FINS' ;
*   moqtopo = 'MODE' curtopo 'THERMIQUE' ;
*   moq = '/' ('INTG' qtopo moqtopo) ('MESU' curtopo) ;
*listreel   lvnul = POSI 0.D0 'DANS' qtopo volutol 'TOUS' ;
*listreel   nnul = 'DIME' lvnul ;
*non ! Les qtopo sont des rapports de longueurs au carré
* Les qtopo sont des rapports de longueurs
*   nnul = 'MASQ' ('EXCO' 'TOP2' qtopo) 'EGINFE' 'SOMME' vprec ;
   nnul = 'MASQ' cqalog 'EGINFE' 'SOMME' vprec ;
   'SI' lres ;
      'RESP' dvol nel nnul nno miq maq meq ;
   'FINS' ;
   'SI' laff ;
*'SI' ('EGA' nnul 0) ;
      jcritq = 'ENTI' ('EXTR' lcritq 1) 'PROC' ;
      titq = 'CHAINE' 'FORMAT' '(E10.3)'
                   ' Dvol=' dvol ' Nel=' nel ' Nel0=' nnul  ' Nno=' nno
                   '  Qmin=' miq ' Qmax=' maq ' Qmed=' meq ' crit=' jcritq ;
      'SI' lmetva ;
         pcritq = 'EXTR' lcritq 2 ;
         qcritq = 'EXTR' lcritq 3 ;
         titq = 'CHAINE' 'FORMAT' '(F4.1)' titq ' p=' pcritq ' q=' qcritq ;
      'FINS' ;
*'SINON' ;
*   titq = 'CHAINE' ' Dvol=' dvol ' N=' nel
*                   ' N0=' nnul ' max=' maq ' moy=' moq ;
*'FINSI' ;
*   titv = 'CHAINE' 'Nb. Elements plats=' nnul ;
      'MESSAGE' titq ;
*   'MESSAGE' titv ;
   'FINS' ;
*
* End of procedure file AFFQUAL
*
'FINS' ;
*
'SI' ('EGA' motcle 'BORD') ;
************************************************************************
* NOM         : BORD
* DESCRIPTION :
*
*
* Procédure BORD qui devient CONTOUR (si dim 2) ou ENVELOPPE (si dim 3)
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 25/08/2016, version initiale
* HISTORIQUE : v1, 25/08/2016, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
'ARGUMENT' mail*'MAILLAGE' ;
*vdim = 'VALEUR' 'DIME' ;
mdim = DEADUTIL 'DIMM' mail ;
mailb = faux ;
'SI' ('EGA' mdim 2) ;
   mailb = 'CONTOUR' mail 'NOID' ;
'FINSI' ;
'SI' ('EGA' mdim 3) ;
   mailb = 'ENVELOPPE' mail 'NOID' ;
*   mailb = 'ENVELOPPE' mail ;
'FINSI' ;
'SI' ('EGA' ('TYPE' mail) 'LOGIQUE') ;
   'ERREUR' ('CHAINE' 'mdim=' mdim) ;
'FINSI' ;
'RESPRO' mailb ;
*
* End of procedure file BORD
*
'FINS' ;
*
'SI' ('EGA' motcle 'FERMEPZ') ;
************************************************************************
* NOM         : FERMEPZ
* DESCRIPTION :
*
* Ferme une topologie en étoilant son contour avec un point donné
*
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 25/08/2016, version initiale
* HISTORIQUE : v1, 25/08/2016, création
* HISTORIQUE : v2  11/06/2018, ajout 2eme maillage servant à la partie
*                 du contour qui ne doit pas être changée
* HISTORIQUE : v3  on decoupe le bord en morceaux plats...
************************************************************************
*
*'DEBPROC' FERMEPZ ;
'ARGUMENT' topo*'MAILLAGE' ;
'ARGU' mailnoch*'MAILLAGE' ;
'ARGU' ialgo*'ENTIER' ;
'ARGU' denstol*'FLOTTANT' ;
'ARGU' impr*'ENTIER' ;
*'ARGUMENT' pferm*'POINT' ;
* Le inverse semble hyper important !!!!
   btopo = MATOUTIL 'BORD' topo ;
   'SI' ('EXIS' mailnoch) ;
      btopo2 = 'DIFF' btopo mailnoch ;
      btopo = btopo2 ;
   'FINS' ;
* Partitionnement
*old Si ialgo=0, il faut verifier l'absence d'elements degeneres au bord
* Si ialgo=0, il faut supprimer les elements degeneres du bord
* sinon part ne peut fonctionner
   lpart= vrai ;
   'SI' ('EGA' ialgo 0) ;
*      ttopo = 'ELEM' topo 'APPUYE' 'ELEM' btopo ;
*      jttopo = DEADJACO ttopo ;
      imetopo = DEADMETR btopo ;
      spetopo = 'TENS' 'PRIN' imetopo ;
* On prend l'avant-derniere valeur propre (la derniere est nulle car element surfacique)
      avdim = '-' ('VALE' 'DIME') 1 ;
      navvp = 'CHAI' 'SI' avdim avdim ;
      avvp  = 'EXCO' navvp spetopo ;
      lavvp = '**' ('ABS' avvp) 0.5 ;
      milavvp = 'MINI' lavvp ; malavvp = 'MAXI' lavvp ;
*      vtol2 = '**' vtol 0.7 ;
*      'MESS' 'FERMEPZ : milavvp=' milavvp ' malavvp=' malavvp ' denstol=' denstol ;
      etopo0 = 'ELEM' lavvp 'EGINFE' denstol ;
      nel0  = 'NBEL' etopo0 ;
      'SI' ('>' nel0 0) ;
         'MESS' '!! FERMEPZ : on enleve' ' '  nel0 ' elements du bord qui sont singuliers.' ;
         'MESS' '!!         : milavvp=' milavvp ' malavvp=' malavvp ' denstol=' denstol ;
         btopo3 = 'DIFF' btopo etopo0 ;
         btopo = btopo3 ;
*         lpart = faux ;
*        btopo0 = MATOUTIL 'BORD' ttopo0 ;
*        ibt = 'INTE' btopo0 btopo ;
*        nibt = 'NBEL' ibt ;
*        'SI' ('>' nibt 0) ;
*           'MESS' '!!         :' ' ' nibt ' elements du bord ne seront pas etoiles.' ;
*           btopo3 = 'DIFF' btopo ibt ;
*           btopo  = btopo3 ;
*        'FINS' ;
      'FINS' ;
*old2      jctopo = 'INDI' 'ISOD' ctopo ;
*old2      mijct = 'MINI' jctopo ; majct = 'MAXI' jctopo ;
*old2      ctopo2 = 'ELEM' jctopo 'SUPERIEUR' vtol 'STRI' ;
*old2      nelv = '-' ('NBEL' ctopo) ('NBEL' ctopo2) ;
*old2      'MESS' 'FERMEPZ : mijct=' mijct ' majct=' majct ' vtol=' vtol ;
*old2      'SI' ('>' nelv 0) ;
*old2         'MESS' '!! FERMEPZ : on enleve' ' ' nelv ' elements du bord.' ;
*old2      'FINS' ;
*old2      ctopo = ctopo2 ;
*old      ttopo = 'ELEM' topo 'APPUYE' 'ELEM' btopo ;
*old      ctop = 'INDI' 'TOP2' ttopo ;
*old      mictop = 'MINI' ctop ;
*old      'SI' ('<' mictop vtol) ;
*old         'SI' ('>EG' impr 2) ;
*old            'MESS' 'minivol=' mictop ' => elements degeneres touchant le bord : pas* de noeud virtuel pour cette passe' ;
*old         'FINS' ;
*old         lpart = faux ;
*old      'FINS' ;
   'FINS' ;
   ctopo = 'INVERSE' btopo ;
* Important que pfermi et tout les noeuds de la face  soient coplanaires.
  'SI' lpart ;
      tbor = 'PART' 'SEPA' ctopo 'ANGL' 0.01 'TELQ' ;
      lbor = 'ENUM' 'TABL' tbor ;
*      lbor = 'ENUM' ctopo ;
      topof = 'ENUM' topo ;
      mpferm = 'ENUM' ;
*   topof = topo 'ET' (ETOILE pferm ctopo) ;
*   topof = topo 'ET' ('COUT' pferm ctopo) ;
      dlbor = 'DIME' lbor ;
      'REPE' iilbor dlbor ;
         ilbor = &iilbor ;
         ibor = 'EXTR' lbor ilbor ;
         pfermi = 'BARY' ibor ;
         topof  = 'ET' topof ('COUT' pfermi ibor) ;
         mpferm = 'ET' mpferm pfermi ;
      'FIN' iilbor ;
* Teste si la topologie résultante est sans bord
*TESTIDMA (BORD topof) ('VIDE' 'MAILLAGE') ;
*'RESPRO' topof ;
      'RESP' ('ETG' topof) ('ETG' mpferm) ;
   'SINO' ;
      'RESP' topo ('VIDE' 'MAILLAGE'/'POI1') ;
   'FINS' ;
* Pas de noeud virtuel
*
* End of procedure file FERMEPZ
*
*'FINPROC' ;
'FINS' ;
*
*
'SI' ('EGA' motcle 'OUVREPZ') ;
************************************************************************
* NOM         : OUVREPZ
* DESCRIPTION :
*
*
* Ouvre une topologie en enlevant les éléments touchant un point donné
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 25/08/2016, version initiale
* HISTORIQUE : v1, 25/08/2016, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*'DEBPROC' OUVREPZ ;
'ARGUMENT' xltopo/'LISTOBJE' ;
lxltopo = 'EXIS' xltopo ;
'SI' ('NON' lxltopo) ;
   'ARGU' topo*'MAILLAGE' ;
   xltopo = 'ENUM' topo ;
'FINS' ;
*'ARGUMENT' pferm*'POINT' ;
'ARGUMENT' mpferm*'MAILLAGE' ;
dltopo = 'DIME' xltopo ;
xltopoo = 'ENUM' ;
'REPE' iltopo dltopo ;
   topo = 'EXTR' xltopo &iltopo ;
   touchp = 'ELEM' topo 'APPUYE' 'LARGEMENT' mpferm 'NOVERIF' ;
   topoo = 'DIFF' topo touchp ;
   xltopoo = xltopoo 'ET' topoo ;
'FIN' iltopo ;
*
'SI' lxltopo ;
   'RESPRO' xltopoo ;
'SINO' ;
   'RESPRO' topoo ;
'FINS' ;
*
* End of procedure file OUVREPZ
*
*'FINPROC' ;
'FINS' ;
*
'SI' ('EGA' motcle 'MOYECHAM') ;
************************************************************************
* NOM         : MOYECHAM
* DESCRIPTION : Fait la moyenne d'un champ par élément (supposé scalaire
*               et constant par élément) au sens : somme des valeurs
*               sur les éléments divisée par le nombre d'éléments.
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stephane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
*               mail : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 02/05/2020, version initiale
* HISTORIQUE : v1, 02/05/2020, creation
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*'DEBPROC' MOYECHAM ;
'ARGUMENT' cha*'MCHAML' ;
*
lco = 'EXTR' cha 'COMP' ;
dco = 'DIME' lco ;
* 320 2
* Il faut specifier un champ par element avec une seule composante
'SI' ('NEG' dco 1) ;
   'ERRE' 320 ;
'FINS' ;
* Change le nom de composante en scal plutôt que qualtopo
* car sinon chan chpo supp plante.
*cha = 'EXCO' ('EXTR' lco 1) cha 'SCAL    ' ;
cha = 'CHAN' 'COMP' 'SCAL    ' cha ;
mai = 'EXTR' cha 'MAIL' ;
nel = 'NBEL' mai ;
*moc = 'MODE' mai 'THERMIQUE' ;
moc = 'MODE' mai 'MECANIQUE' ;
*'MESS' 'moyecham : gravit' ;
cha2 = 'CHAN' 'CHAM' cha moc 'GRAVITE' 'SCALAIRE' ;
* Pb ici
*cha1 = 'MANU' 'CHML' moc 'SCAL' 1. 'TYPE' 'SCALAIRE' 'GRAVITE' ;
*chavol = 'INTG' moc cha1 'ELEM' ;
*'LIST' 'RESU' chavol ;
*'ERRE' stop ;
*ms = 'MOTS' 'SCAL' ;
*'LIST' 'RESU' cha ;
*'LIST' 'RESU' cha2 ;
*'LIST' 'RESU' cha1 ;
*'LIST' 'RESU' chavol ;
* chavol est nul sur les éléments de volume nul
*cha2v = '/' cha2 chavol ms ms ms ;
*som = 'INTG' moc cha2v ;
* Plante sur une erreur 5.
*'MESS' 'moyecham : chpo' ;
chp2 = 'CHAN' 'CHPO' moc cha2 'SUPP' ;
som = 'MAXI' ('RESU' chp2) ;
moy = '/' som nel ;
'RESPRO' moy ;
*
* End of procedure file MOYECHAM
*
*'FINPROC' ;
'FINS' ;
*
'SI' ('EGA' motcle 'AFFCAND') ;
************************************************************************
* NOM         : AFFCAND
* DESCRIPTION :
*
* Procédure pour afficher une table de candidat + la valeur dun critère
* en coloriant le candidat
*
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 25/08/2016, version initiale
* HISTORIQUE : v1, 25/08/2016, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*'DEBPROC' AFFCAND ;
'ARGUMENT' tcand/'TABLE' ;
'SI' ('NON' ('EXISTE' tcand)) ; tcand = 'TABLE' ; 'FINSI' ;
'REPETER' boumail ;
   'ARGUMENT' mail/'MAILLAGE' ;
   'SI' ('EXISTE' mail) ;
      itab = '+' ('DIME' tcand) 1 ;
      tcand . itab = mail ;
   'SINON' ;
      'QUITTER' boumail ;
   'FINSI' ;
'FIN' boumail ;
*
ltypost = 'MOTS' 'MAIL' 'VOLU' 'QUAL' ;
'ARGU' typost*'MOT' ;
itypost = 'POSI' typost 'DANS' ltypost ;
'SI' ('EGA' itypost 0) ;
*Mot-clé incorrect "%M1:4". Voici la liste des valeurs admises :
   'ERRE' 1052 'AVEC' typost 'MAIL VOLU QUAL' ;
'FINS' ;
*
tit = 'GOONI FECIT' ;
momet = 'GEOM' ;
*
lmotcle = 'MOTS' 'VMET' 'TITR' 'ARIT' 'GEOM' ;
'REPETER' imotcle ;
   'ARGUMENT' motcle/'MOT' ;
   'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
*   'MESS' ('CHAI' 'affcand.proc : mot-cle lu :' motcle) ;
   'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
      cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
   'FINSI' ;
   'SI' ('EGA' motcle 'VMET') ;
      'ARGU' metva ;
*      'MESS' ('CHAI' 'affcand.proc : metva=') ;
*      'LIST' ('TYPE' metva);
   'FINS' ;
   'SI' ('EGA' motcle 'TITR') ;
      'ARGU' tit*'MOT' ;
   'FINS' ;
   'SI' ('EGA' motcle 'ARIT') ; momet = motcle ; 'FINS' ;
   'SI' ('EGA' motcle 'GEOM') ; momet = motcle ; 'FINS' ;
'FIN' imotcle ;
*
ncand = 'DIME' tcand ;
'SI' ('NON' ('>' ncand 0)) ;
   'ERREUR' 'Table vide' ;
'FINSI' ;
dx = 0. ;
mtot = 'VIDE' 'MAILLAGE' ;
chvol = 'VIDE' 'CHPOINT'/'DIFFUS' ;
mqual = 'VIDE' 'MMODEL' ;
cqual = 'VIDE' 'MCHAML' ;
vdim = 'VALEUR' 'DIME' ;
'REPETER' icand ncand ;
   tcandi = tcand . &icand ;
   mdec = tcandi ;
   mtot = 'ET' mtot mdec ;
   xm = 'COORDONNEE' 1 tcandi ;
   ddx = '*' ('-' ('MAXIMUM' xm) ('MINIMUM' xm)) 1.1 ;
   dx = '+' dx ddx ;
   'SI' ('EGA' itypost 2) ;
      cdec = 'MANUEL' 'CHPO' mdec 1 'SCAL' ('MESURE' mdec)
               'NATURE' 'DIFFUS' ;
      chvol = 'ET' chvol cdec ;
   'FINSI' ;
   'SI' ('EGA' itypost 3) ;
      modec = 'MODE' mdec 'THERMIQUE' ;
      mqual = 'ET' mqual modec ;
      'SI' ('EXIS' metva) ;
         cdec = 'INDI' 'TOP2' mdec metva momet ;
      'SINO' ;
         cdec = 'INDI' 'TOP2' mdec ;
      'FINS' ;
      cqual = 'ET' cqual cdec ;
   'FINSI' ;
'FIN' icand ;
*mtra = mtot 'ET' cnt ;
mtra = mtot ;
echq = 'PROG' 0. 'PAS' ('/' 1. 20.) 1. ;
*echv = 'PROG' volucib 'PAS' ('/' ('-' voluini volucib) 20.) voluini ;
*'SI' lnclk ;
*   'SI' ('EGA' itypost 1) ;
*      'TRACER' mtra 'TITR' tit 'NCLK' ;
*   'FINSI' ;
*   'SI' ('EGA' itypost 2) ;
*      'TRACER' chvol mtot mtra 'TITR' tit 'NCLK' ;
*   'FINSI' ;
*   'SI' ('EGA' itypost 3) ;
*      'TRACER' cqual mqual mtra echq 'TITR' tit 'NCLK' ;
*   'FINSI' ;
*'SINON' ;
   'SI' ('EGA' itypost 1) ;
      'TRACER' mtra 'TITR' tit  ;
   'FINSI' ;
   'SI' ('EGA' itypost 2) ;
*   'LISTE' echv ; 'LISTE' mtot ;'LISTE' mtra ; 'LISTE' chvol ;
      'TRACER' chvol mtot mtra  'TITR' tit  ;
   'FINSI' ;
   'SI' ('EGA' itypost 3) ;
      'TRACER' cqual mqual mtra echq 'TITR' tit  ;
   'FINSI' ;
*'FINSI' ;
*
* End of procedure file AFFCAND
*
*'FINPROC' ;
'FINS' ;
*
'SI' ('EGA' motcle 'MAILINTE') ;
************************************************************************
* NOM         : MAILINTE
* DESCRIPTION :
*
*
* Procédure MAILINTE qui devient SURF (si dim 2) ou VOLU (si dim 3)
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 25/09/2017, version initiale
* HISTORIQUE : v1, 25/09/2017, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*'DEBPROC' MAILINTE ;
'ARGUMENT' mail*'MAILLAGE' ;
vdim = 'VALEUR' 'DIME' ;
mailb = faux ;
'SI' ('EGA' vdim 2) ;
   mailb = 'SURF' mail ;
'FINSI' ;
'SI' ('EGA' vdim 3) ;
   mailb = 'VOLU' mail 'VERB' ;
'FINSI' ;
'SI' ('EGA' ('TYPE' mail) 'LOGIQUE') ;
   'ERREUR' ('CHAINE' 'vdim=' vdim) ;
'FINSI' ;
'RESPRO' mailb ;
*
* End of procedure file MAILINTE
*
*'FINPROC' ;
'FINS' ;
'SI' ('EGA' motcle 'VERITOPO') ;
************************************************************************
* NOM         : VERITOPO
* DESCRIPTION :
*
*
* Procédure VERITOPO qui verifie une topologie (i.e. un maillage massif)
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 03/11/2025, version initiale
* HISTORIQUE : v1, 03/11/2025, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*'DEBPROC' VERITOPO ;
'ARGUMENT' xxxtopo*'MAILLAGE' ;
'ARGU' xxxvolucib/'FLOTTANT' ;
lvolucib = 'EXIS' xxxvolucib ;
'SI' lvolucib ;
   'ARGU' volutol*'FLOTTANT' ;
'FINS' ;
'ARGU' xxxdesc*'MOT' ;
'SI' ('NON' ('EXIS' xxxdesc)) ; xxxdesc = 'CHAI' 'VERITOPO :' ; 'FINS' ;
'ARGU' xxxmbnc/'MAILLAGE' ;
lok = vrai ;
vdim = 'VALEUR' 'DIME' ;
*
* Verification pas d'elements en double
*
xxxtopou = 'UNIQ' xxxtopo ;
dnode = '-' ('NBEL' xxxtopo) ('NBEL' xxxtopou) ;
'SI' ('NEG' dnode 0) ;
   'MESSAGE' xxxdesc ' ' dnode ' elements en double' ;
   lok = lok 'ET' faux ;
'FINS' ;
*
* Verification que le bord est ferme
*
lbord = vrai ;
'SI' ('EGA' vdim 2) ;
   bxxxtopo = 'CONT' 'EXTE' xxxtopo ;
   citopo   = 'CONT' 'INTE' xxxtopo 'NOID' ;
   'SI' ('NEG' ('NBEL' citopo) 0) ;
      'MESS' xxxdesc ' Aretes partagees par plus de deux elements' ;
      lbord = lbord 'ET' faux ;
   'FINS' ;
   pbor = 'POIN' bxxxtopo 'EXTR' ;
   'SI' ('NEG' ('NBEL' pbor) 0) ;
      'MESS' xxxdesc ' Bord non ferme' ;
      lbord = lbord 'ET' faux ;
   'FINS' ;
'FINS' ;
'SI' ('EGA' vdim 3) ;
   bxxxtopo = 'ENVE' xxxtopo ;
   cnext = 'CONT' 'EXTE' bxxxtopo 'NOID' ;
   'SI' ('NEG' ('NBEL' cnext) 0) ;
      'MESS' xxxdesc ' Bord non ferme' ;
      lbord = lbord 'ET' faux ;
   'FINS' ;
   cnint = 'CONT' 'INTE' bxxxtopo 'NOID' ;
   'SI' ('NEG' ('NBEL' cnint) 0) ;
      'MESS' xxxdesc ' Bord non simple' ;
*      lbord = lbord 'ET' faux ;
   'FINS' ;
'FINS' ;
lok = lok 'ET' lbord ;
*
* Volume toujours correct ?
*
'SI' lvolucib ;
   volv = 'MESU' xxxtopo ;
   dvolv = '-' xxxvolucib volv ;
   'SI' ('NEG' dvolv 0 volutol) ;
      'MESSAGE' xxxdesc ' Volume (mesu) modifie vol=' volv ' / volucib=' xxxvolucib  ;
      'MESSAGE' xxxdesc '                      dvol=' dvolv ;
      lok = lok 'ET' faux ;
   'FINS' ;
   'SI' lbord ;
      vols = MATOUTIL 'MESUINTE' bxxxtopo ;
      dvols = '-' xxxvolucib vols ;
      'SI' ('NEG' dvols 0 volutol) ;
         'MESSAGE' xxxdesc ' Volume (mesuinte) modifie vol=' vols ' / volucib=' xxxvolucib  ;
         'MESSAGE' xxxdesc '                          dvol=' dvols ;
         lok = lok 'ET' faux ;
      'FINS' ;
   'FINS' ;
'FINS' ;
*
* mbnc toujours inclus dans le bord ?
*
'SI' ('EXIS' xxxmbnc) ;
   mi = 'INTE' xxxmbnc bxxxtopo 'NOVERIF' ;
   'SI' ('NEG' ('NBEL' ('DIFF'  mi xxxmbnc)) 0) ;
      'MESSAGE' xxxdesc ' bord_no_chan non inclus dans le bord'  ;
      'TRAC' (mi 'ET' ('COUL' bxxxtopo 'ROUG')) ;
      lok = lok 'ET' faux ;
   'FINS' ;
'FINS' ;
'RESPRO' lok ;
*
* End of procedure file VERITOPO
*
*'FINPROC' ;
'FINS' ;
*
* End of procedure file MATOUTIL
*
'FINPROC' ;
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales