$$$$ DEADUTIL
* DEADUTIL  PROCEDUR  GOUNAND   26/01/12    21:15:02     12448          
************************************************************************
* NOM         : DEADUTIL
* DESCRIPTION :
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 05/04/2006, version initiale
* HISTORIQUE : v1, 05/04/2006, création
* HISTORIQUE : 2018/01/22 : chgt nom composante hors diago G21 au lieu
*                           de G12 pour QEQU et QISO
* HISTORIQUE : 2018/10/10 : NLINP au lieu de NLIN
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
* Prière de PRENDRE LE TEMPS de compléter les commentaires
* en cas de modification de ce sous-programme afin de faciliter
* la maintenance !
************************************************************************
*
*
'DEBPROC' DEADUTIL ;
*
'ARGUMENT' motcle*'MOT' ;
*
lmotcle = 'MOTS' 'DIMM' 'TYPM' 'AXI?' 'SPH?' 'QISO' 'QALI' 'QEQU' 'INDI' ;
'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
   'ERRE' 1052 'AVEC' motcle 'DIMM TYPM AXI? SPH? QISO QALI QEQU INDI' ;
'FINSI' ;
*
'SI' ('EGA' motcle 'AXI?') ;
   vmod = 'VALEUR' 'MODE' ;
   laxi = ('EGA' vmod 'AXIS') 'OU' ('EGA' vmod 'UNIDAXIS')
     'OU' ('EGA' vmod 'UNIDAXISAXDZ') 'OU' ('EGA' vmod 'UNIDAXISAXCZ')
     'OU' ('EGA' vmod 'UNIDAXISAXGZ') ;
   'RESPRO' laxi ;
'FINSI' ;
*
'SI' ('EGA' motcle 'SPH?') ;
   vmod = 'VALEUR' 'MODE' ;
   lsph = 'EGA' vmod 'UNIDSPHE' ;
   'RESPRO' lsph ;
'FINSI' ;
*
'SI' ('EGA' motcle 'DIMM') ;
'ARGUMENT' mt*'MAILLAGE' ;
tabdim = 'TABLE' ;
tabdim . 0 = 'MOTS' 'POI1' ;
tabdim . 1 = 'MOTS' 'SEG2' 'SEG3' ;
tabdim . 2 = 'MOTS' 'TRI3' 'TRI6' 'TRI7' 'QUA4' 'QUA8' 'QUA9' ;
tabdim . 3 = 'MOTS' 'CUB8' 'CU20' 'PRI6' 'PR15' 'TET4' 'TE10'
                    'PYR5' 'PY13' 'CU27' 'PR21' 'TE15' 'PY19' ;
fidim = FAUX ;
dim = -1 ;
lelem = 'ELEM' mt 'TYPE' ;
nelem = 'DIME' lelem ;
'SI' ('EGA' nelem 0) ;
*1027 2
*Une donnee de type %M1:8 est vide
   'ERRE' 1027 'AVEC' 'MAILLAGE' ;
'FINSI' ;
*
'REPETER' ielem nelem ;
   melem = 'EXTRAIRE' lelem &ielem ;
   'REPETER' itdim 4 ;
      idim = ('-' &itdim 1) ;
      lli = tabdim . idim ;
*     id = ISINLIS melem lli ;
*      'SI' ('NEG' id 0) ;
      id = 'EXISTE' lli melem ;
      'SI' id ;
         'SI' fidim ;
            'SI' ('NEG' dim idim) ;
               cherr = 'CHAINE' 'Composite mesh not allowed' ;
               'ERREUR' cherr ;
            'FINSI' ;
         'SINON' ;
            dim = idim ;
            fidim = VRAI ;
         'FINSI' ;
      'FINSI' ;
   'FIN' itdim ;
'FIN' ielem ;
*
'SI' ('NON' fidim) ;
   cherr = 'CHAINE' 'No known elements in this mesh' ;
   'ERREUR' cherr ;
'FINSI' ;
*
'RESPRO' dim ;
'FINSI' ;
*
*
*
'SI' ('EGA' motcle 'TYPM') ;
'ARGUMENT' mt*'MAILLAGE' ;
tabtyp = 'TABLE' ;
tabtyp . 1 = 'MOTS' 'SEG2' 'TRI3' 'QUA4' 'CUB8' 'PRI6' 'TET4' 'PYR5'  ;
tabtyp . 2 = 'MOTS'        'TRI6' 'QUA8' 'CU20' 'PR15' 'TE10' 'PY13'  ;
tabtyp . 3 = 'MOTS' 'SEG3' 'TRI7' 'QUA9' 'CU27' 'PR21' 'TE15' 'PY19'  ;
listyp = 'MOTS' 'LINE' 'QUAI' 'QUAF' ;
*
fityp = FAUX ;
typ = -1 ;
lelem = 'ELEM' mt 'TYPE' ;
nelem = 'DIME' lelem ;
'SI' ('EGA' nelem 0) ;
*1027 2
*Une donnee de type %M1:8 est vide
   'ERRE' 1027 'AVEC' 'MAILLAGE' ;
'FINSI' ;
*
'REPETER' ielem nelem ;
   melem = 'EXTRAIRE' lelem &ielem ;
   'REPETER' ittyp 3 ;
      ityp = &ittyp ;
      lli = tabtyp . ityp ;
*      id = ISINLIS melem lli ;
*      'SI' ('NEG' id 0) ;
      id = 'EXISTE' lli melem ;
      'SI' id ;
         'SI' fityp ;
            'SI' ('NEG' typ ityp) ;
               cherr = 'CHAINE' 'Composite mesh not allowed' ;
               'ERREUR' cherr ;
            'FINSI' ;
         'SINON' ;
            typ = ityp ;
            fityp = VRAI ;
         'FINSI' ;
      'FINSI' ;
   'FIN' ittyp ;
'FIN' ielem ;
*
'SI' ('NON' fityp) ;
   cherr = 'CHAINE' 'No known elements in this mesh' ;
   'ERREUR' cherr ;
'FINSI' ;
*
mtyp = 'EXTRAIRE' listyp typ ;
'RESPRO' mtyp ;
'FINSI' ;
*
* QISO  PROCEDUR  GOUNAND   06/04/06    17:53:15     5371
************************************************************************
* NOM         : QISO
* DESCRIPTION : Critère de qualité d'un maillage : alignement
*               (= isotropie)
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 11/05/2007, version initiale
* HISTORIQUE : v1, 11/05/2007, création
* HISTORIQUE : 2018/01/22 : chgt nom composante hors diago G21 au lieu
*                           de G12
* HISTORIQUE : 2025/11/20 : mutualisation avec QEQU
* HISTORIQUE :
************************************************************************
* Prière de PRENDRE LE TEMPS de compléter les commentaires
* en cas de modification de ce sous-programme afin de faciliter
* la maintenance !
************************************************************************
*
*
*
'SI' ('EXIS' ('MOTS' 'QISO' 'QALI' 'QEQU' 'INDI') motcle) ;
*
'SI' ('EGA' motcle 'INDI') ;
   lindic  = 'MOTS' ;
   lindic2 = 'MOTS' ;
   lindicv = 'MOTS' 'COHE' 'EQLT' 'ISOD' 'DENS' 'TOPO' ;
   'REPE' bmcle ;
      'ARGU' mindic/'MOT' ;
      'SI' ('NON' ('EXIS' mindic)) ; 'QUIT' bmcle ; 'FINS' ;
      indicok = 'EXIS' lindicv mindic ;
      'SI' ('NON' indicok) ;
         lindic2 = lindic2 'ET' mindic ;
      'SINO' ;
         lindic = lindic 'ET' mindic ;
      'FINS' ;
   'FIN' bmcle ;
'SINO' ;
   lindic = 'MOTS' motcle ;
   lindic2 = 'MOTS' ;
   'REPE' bmcle ;
      'ARGU' mindic/'MOT' ;
      'SI' ('NON' ('EXIS' mindic)) ; 'QUIT' bmcle ; 'FINS' ;
      lindic2 = lindic2 'ET' mindic ;
   'FIN' bmcle ;
'FINS' ;
*
'ARGUMENT' mail*'MAILLAGE' ;
*
*lmotcle2 = 'MOTS' 'METR' 'DISG' 'METG' 'DENS' ;
lmotcle2 = 'MOTS' 'METR' 'DISG' 'METG' ;
*
lchad = FAUX ; lchp = FAUX ;
ldisg   = FAUX ;
lmg = FAUX ;
lmetdisc = faux ;
*
idim = 'VALEUR' 'DIME' ;
*
'REPETER' imcle2 ('DIME' lindic2) ;
   motcle2 = 'EXTR' lindic2 &imcle2 ;
   lmc = 'EXISTE' lmotcle2 motcle2 ;
   'SI' ('NON' lmc) ;
*1052 2
*Mot-cle incorrect "%M1:4". Voici la liste des valeurs admises : %M5:40
*      'ERRE' 1052 'AVEC' ('CHAI' motcle2 'METR DISG METG DENS') ;
      'ERRE' 1052 'AVEC' motcle2 'METR DISG METG' ;
   'FINSI' ;
*
   'SI' ('EGA' motcle2 'METR') ;
      'ARGU' tai/'FLOTTANT' ;
      'SI' ('EXIS' tai) ;
         itai2 = tai '**' -2 ;
         chpt = 'MANU' 'CHPO' 1 mail 'G' itai2 'NATURE' 'DIFFUS' ;
         chp = chpt ;
         lchp = vrai ; lchad = faux ;
      'SINO' ;
         'ARGUMENT' chad/'MCHAML' ;
         lchad = 'EXISTE' chad ;
         'SI' ('NON' lchad) ;
            'ARGUMENT' chp/'CHPOINT' ;
            lchp = 'EXISTE' chp ;
            'SI' lchp ;
               'ARGUMENT' metdisc/'MOT' ;
            'FINS' ;
            lmetdisc = 'EXIS' metdisc ;
         'SINON' ;
            argu kmodl1*'MMODEL' ;
            lchp = FAUX ;
         'FINSI' ;
      'FINS' ;
   'FINS' ;
*   'SI' ('EGA' motcle2 'DENS') ;
*      'ARGUMENT' chp*'CHPOINT' ;
*      chp    = 'REDU' chp mail ;
*      kmodl1 = 'MODE' mail 'THERMIQUE' ;
*      chad   = 'CHAN' 'CHAM' kmodl1 chp ;
*      chad   = (chad ** -2) 'NOMC' 'G' ;
*      lchad  = VRAI ;
*      lchp   = FAUX ;
*   'FINSI' ;
*
   'SI' ('EGA' motcle2 'DISG') ;
      'ARGUMENT' gdisc*'MOT' ;
      ldisg = VRAI ;
   'FINSI' ;
*
   'SI' ('EGA' motcle2 'METG') ;
      'ARGUMENT' methgau*'MOT' ;
      lmg = VRAI ;
   'FINSI' ;
*
'FIN' imcle2 ;
lmet = 'OU' lchad lchp ;
*
* Initialisations
*
imod = 'VALEUR' 'MODE' ;
vdim = DEADUTIL 'DIMM' mail ;
vtyp = DEADUTIL 'TYPM' mail ;
laxi = DEADUTIL 'AXI?' ;
lsph = DEADUTIL 'SPH?' ;
*
'SI' ('OU' ('<' idim 1) ('>' idim 3)) ;
* 709 2 Fonction indisponible en dimension %i1.
   'ERREUR' 709 'AVEC' idim ;
'FINSI' ;
'SI' (('EGA' imod 'AXIS') 'OU' ('EGA' imod 'UNIDAXIS') 'OU'
   ('EGA' imod 'FOUR') 'OU' ('EGA' imod 'SPHE')) ;
*-105 0 Mode de calcul actuel %m1:32
   'ERRE'  -105 'AVEC' imod ;
* 710 2 Fonction indisponible pour ce mode de calcul
   'ERRE' 710 ;
'FINSI' ;
*
vquaf = ('EGA' vtyp 'QUAF') ;
'SI' ('ET' ldisg ('NON' vquaf)) ;
   'MESS' 'DISG option :' ;
*  66 2 L'objet %m1:8 doit etre de type %m9:16
   'ERRE' 66 'AVEC' 'MAIL    QUAF' ;
'FINSI' ;
*
* Maillage
*
*'SI' vquaf ;
   _mt = mail ;
*'SINON' ;
*   _mt = 'CHANGER' mail 'QUAF' ;
*'FINSI' ;
*
* Inconnus et discrétisation
*
'SI' ('NON' lmg) ;
   'SI' ('EGA' vtyp 'LINE') ;
      methgau = 'GAM1' ;
   'SINON' ;
      methgau = 'GAM2' ;
   'FINSI' ;
'FINSI' ;
'SI' ('NON' ldisg) ;
   gdisc   = vtyp ;
'FINSI' ;
*
* Métrique
*
ncmet  = '/' ('*' idim ('+' idim 1)) 2 ;
lnmet = 'TABL' ;
lnmet . 1 = 'MOTS' 'G11' ;
lnmet . 2 = 'MOTS' 'G11' 'G22' 'G21' ;
lnmet . 3 = 'MOTS' 'G11' 'G22' 'G21' 'G33' 'G31' 'G32' ;
'SI' lmet;
   'SI' lchad ;
      chpmet  = 'CHANGER' 'CHPO' kmodl1 chad ;
      metdisc = gdisc ;
   'FINSI' ;
   'SI' lchp ;
      chpmet = chp ;
      'SI' ('NON' lmetdisc) ;
         metdisc = gdisc ;
      'FINS' ;
   'FINSI' ;
   lncom = 'EXTR' chpmet 'COMP' ;
   dncom = 'DIME' lncom ;
   'SI' ('EGA' dncom 1) ;
      'SI' ('EGA' ('TYPE' chpmet) 'CHPOINT') ;
         chpmet = 'NOMC' 'G11' chpmet 'NATURE' 'DIFFUS' ;
      'SINO' ;
         chpmet = 'NOMC' 'G11' chpmet ;
      'FINS' ;
      chpmett = chpmet ;
      'SI' ('>' idim 1) ;
         chpmet0 = chpmet '*' 0. ;
         chpmet  = chpmet 'ET' (chpmett 'NOMC' 'G22') 'ET' (chpmet0 'NOMC' 'G21') ;
      'FINS' ;
      'SI' ('>' idim 2) ;
         chpmet  = chpmet 'ET' (chpmett 'NOMC' 'G33') 'ET' (chpmet0 'NOMC' 'G31') 'ET' (chpmet0 'NOMC' 'G32') ;
      'FINS' ;
      lncom = 'EXTR' chpmet 'COMP' ;
      dncom = 'DIME' lncom ;
   'FINS' ;
   'SI' ('OU' ('NEG' dncom ncmet) ('NON' ('EXIS' (lnmet . idim) lncom 'ET' ))) ;
      'MESS' 'Noms de composantes metrique pas OK :' ;
      'LIST' lncom ;
      'LIST' (lnmet . idim) ;
      'ERRE' 1127 avec 'DEADUTIL' ;
  'FINS' ;
'FINSI' ;
*
dlindic = 'DIME' lindic ;
'SI' ('NON' ldisg) ;
   cindict = 'VIDE' 'MCHAML' ;
'SINO' ;
   cindict = 'VIDE' 'CHPOINT'/'DIFFUS' ;
'FINS' ;
lali = 'MOTS' 'QISO' 'QALI' 'COHE' 'EQLT' ;
lequ = 'MOTS' 'QEQU' 'ISOD' 'DENS' ;
'REPE' ilindic dlindic ;
   nomindic = 'EXTR' lindic &ilindic ;
   'SI' ('EGA' nomindic 'TOPO') ;
      'SI' lmet ;
         vfonc = 'INDI' 'TOP2' mail chpmet ;
      'SINO' ;
         vfonc = 'INDI' 'TOP2' mail ;
      'FINS' ;
      ncompo = 'EXTR' vfonc 'COMP' ;
      ncompn = 'MOTS' ;
      'REPE' iicomp ('DIME' ncompo) ;
         icomp = &iicomp ;
         'SI' ('EGA' icomp 1) ;
            ncompi = 'CHAI' 'TOPO' ;
         'SINO' ;
            ncompi = 'CHAI' 'TOPO' icomp ;
         'FINS' ;
         ncompn = ncompn 'ET' ncompi ;
      'FIN' iicomp ;
      cindic = 'EXCO' ncompo vfonc ncompn ;
* Homogene a une longueur
*      'SI' ('>' vdim 2) ;
*         vfonc = '**' vfonc ('/' 1. ('-' vdim 1)) ;
*      'FINS' ;
   'SINO' ;
      'SI' ('EXIS' lali nomindic) ;
         loi   = 'CHAI' 'QALI' ;
      'FINS' ;
      'SI' ('EXIS' lequ nomindic) ;
         loi   = 'CHAI' 'QEQU' ;
      'FINS' ;
      'SI' ('EGA' nomindic 'EQLT') ;
         lmet2 = FAUX ;
      'SINO' ;
         lmet2 = lmet ;
      'FINS' ;
*
* Calcul de la fonctionnelle
*
      numop  = 1 ;
      numvar = 1 ;
      numder = vdim ;
      numdat = 0 ;
      numcof = 0 ;
*
      A = ININLIN numop numvar numdat numcof numder ;
      A . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
*
      numvar = 1 ;
      numdat = ncmet ;
      numcof = 1 ;
      B = ININLIN numop numvar numdat numcof numder ;
      B . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
*
      idat = 0 ;
      'REPETER' idi idim ;
         nomdat = 'CHAINE' 'G' &idi &idi ;
*         'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ;
         idat = '+' idat 1 ;
         B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ;
         'SI' lmet2 ;
            B . 'DAT' . idat . 'DISC'   = metdisc ;
            B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat chpmet nomdat ;
         'SINON' ;
            B . 'DAT' . idat . 'VALEUR' = 1.D0 ;
         'FINSI' ;
      'FIN' idi ;
      'REPETER' idi idim ;
         nj = '-' idim &idi ;
*      'MESSAGE' ('CHAINE' 'nj=' nj) ;
         'SI' ('>EG' nj 1) ;
            'REPETER' jdi nj ;
* Mise en cohérence avec Castem
*            nomdat = 'CHAINE' 'G' &idi ('+' &idi &jdi) ;
               nomdat = 'CHAINE' 'G' ('+' &idi &jdi) &idi ;
*               'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ;
               idat = '+' idat 1 ;
               B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ;
               'SI' lmet2 ;
                  B . 'DAT' . idat . 'DISC'   = metdisc ;
                  B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat chpmet nomdat ;
               'SINON' ;
                  B . 'DAT' . idat . 'VALEUR' = 0.D0 ;
               'FINSI' ;
            'FIN' jdi ;
         'FINSI' ;
      'FIN' idi ;
      lisdat = 'LECT' 1 'PAS' 1 'NPAS' ('-' numdat 1) ;
*
      B . 'COF' . 1 . 'COMPOR' = loi ;
      B . 'COF' . 1 . 'LDAT'   = lisdat ;
*
      A . 1 . 1 . 0  = 0 ;
      B . 1 . 1 . 0  = 1 ;
*
      'SI' ('NON' ldisg) ;
         vfonc = NLINP gdisc _mt A B 'ERF1' 'CHAM' methgau ;
      'SINO' ;
         vfonc = NLINP gdisc _mt A B 'ERF1' methgau ;
      'FINS' ;
*
*   'LIST' nomindic ;
*   'LIST' lmet2 ;
*   'LIST' vfonc ;
*
      'SI' ('EXIS' lequ nomindic) ;
         'SI' ('EGA' nomindic 'DENS') ;
* Homogene a une longueur
            'SI' ('>' vdim 1) ;
               vfonc = '**' vfonc ('/' 1. vdim) ;
            'FINS' ;
* On remet les valeurs entre 0 et 1
            mvfonc = 'MASQ' vfonc 'SUPERIEUR' 1. ;
            pvfonc = 1. '-' mvfonc ;
            ivfonc = '**' vfonc -1 ;
            vfonc = '+' ('*' mvfonc ivfonc)  ('*' pvfonc vfonc) ;
         'SINO' ;
            tvfonc = 'TYPE' vfonc ;
            'SI' ('EGA' tvfonc 'CHPOINT') ;
               rvfonc = 'MAXI' ('RESU' vfonc) ;
            'SINO' ;
*               'LIST' 'RESU' vfonc ;
*               'LIST' 'RESU' ('EXTR' vfonc 'MAIL') ;
* On utilise un modele MECANIQUE car le modele THERMIQUE ne supporte pas les QUAFs
               vfonc2 = 'CHAN' vfonc ('MODE' ('EXTR' vfonc 'MAIL') 'MECANIQUE') 'GRAVITE' ;
               rvfonc = 'SOMM' ('EXTR' vfonc2 'VALE' 'SCAL') ;
            'FINS' ;
* Facteur de ponderation dependant du type d'element car l'element
* de reference est equilateral d'arete 1, mais pas de volume 1
            rvelemr = 'FLOTTANT' ('NBEL' _mt) ;
            fac = '/' rvelemr rvfonc ;
*         'MESS' 'FACTEUR EQU=' fac ;
            vfonc  = '*' vfonc fac ;
         'FINS' ;
      'FINS' ;
* On remet les valeurs entre 1 et +inf
*      'SI' ('EXIS' ('MOTS' 'COHE' 'EQLT') nomindic) ;
      'SI' ('EXIS' ('MOTS' 'QISO' 'QALI') nomindic) ;
         vfonc = '**' vfonc -1 ;
      'FINS' ;
      cindic =  'NOMC' vfonc nomindic ;
   'FINS' ;
   cindict = cindict 'ET' cindic ;
'FIN' ilindic ;
*
'RESPRO' cindict ;
'FINSI' ;
*
*
* End of procedure file DEADUTIL
*
'FINPROC' ;