$$$$ DEADUTIL
* DEADUTIL  PROCEDUR  GOUNAND   07/07/05    21:15:22     5784           
************************************************************************
* 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 :
* 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' 'QEQU' ;
'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
   cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ;
   'ERREUR' cherr ;
'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) ;
   cherr = 'CHAINE' 'Maillage vide ?' ;
   'ERREUR' cherr ;
'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) ;
   cherr = 'CHAINE' 'Void mesh ?' ;
   'MESSAGE' cherr ;
   'QUITTER' TYPM ;
'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 :
* 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' ('EGA' motcle 'QISO') ;
*
'ARGUMENT' _mt*'MAILLAGE' ;
'ARGUMENT' gdisc*'MOT' ;
'ARGUMENT' methgau*'MOT' ;
*
idim  = 'VALEUR' 'DIME' ;
vdim  = DEADUTIL 'DIMM' _mt ;
*
'ARGUMENT' met/'CHPOINT' ;
lmet = 'EXISTE' met ;
'SI' lmet ;
   'ARGUMENT' metdisc*'MOT' ;
'SINON' ;
   metdisc = 'CSTE' ;
'FINSI' ;   
*
ncmet  = '/' ('*' idim ('+' idim 1)) 2 ;
loi = 'CHAINE' 'QALI' ;
*
* Calcul de la fonctionnelle
*
numop  = 1 ;
numvar = 1 ;
numder = vdim ;
numdat = 0 ;
numcof = 0 ;
*
   A = ININLIN numop numvar numdat numcof numder ;   
   A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
   A . 'VAR' . 1 . 'DISC'   = 'CSTE' ;
   A . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
*
   numvar = 1 ;
   numdat = ncmet ;
   numcof = 1 ;
   B = ININLIN numop numvar numdat numcof numder ;
   B . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
   B . 'VAR' . 1 . 'DISC'   = 'CSTE' ;
   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 ;
      B . 'DAT' . idat . 'DISC'   = metdisc ;
      'SI' lmet ;
         B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met 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 ;
            nomdat = 'CHAINE' 'G' &idi ('+' &idi &jdi) ;
*               'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ;
            idat = '+' idat 1 ;
            B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ;
            B . 'DAT' . idat . 'DISC'   = metdisc ;
            'SI' lmet ;
               B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met 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  = 'LECT' ;
   B . 1 . 1 . 0  = 'LECT' 1 ;
*
vfonc = 'NLIN' gdisc _mt A B 'ERF1' methgau ;
* 
'RESPRO' vfonc ;
'FINSI' ;
*
* QEQU  PROCEDUR  GOUNAND   06/04/06    17:53:15     5371           
************************************************************************
* NOM         : QEQU
* DESCRIPTION : Critère de qualité d'un maillage : equidistribution
*
*
*
* 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 :
* 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' ('EGA' motcle 'QEQU') ;
*
'ARGUMENT' _mt*'MAILLAGE' ;
'ARGUMENT' gdisc*'MOT' ;
'ARGUMENT' methgau*'MOT' ;
*
idim  = 'VALEUR' 'DIME' ;
vdim  = DEADUTIL 'DIMM' _mt ;
*
'ARGUMENT' met/'CHPOINT' ;
lmet = 'EXISTE' met ;
'SI' lmet ;
   'ARGUMENT' metdisc*'MOT' ;
'SINON' ;
   metdisc = 'CSTE' ;
'FINSI' ;   
ncmet  = '/' ('*' idim ('+' idim 1)) 2 ;
loi = 'CHAINE' 'QEQU' ;
*
* Calcul de la fonctionnelle
*
numop  = 1 ;
numvar = 1 ;
numder = vdim ;
numdat = 0 ;
numcof = 0 ;
*
   A = ININLIN numop numvar numdat numcof numder ;   
   A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
   A . 'VAR' . 1 . 'DISC'   = 'CSTE' ;
   A . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
*
   numvar = 1 ;
   numdat = ncmet ;
   numcof = 1 ;
   B = ININLIN numop numvar numdat numcof numder ;
   B . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
   B . 'VAR' . 1 . 'DISC'   = 'CSTE' ;
   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 ;
      B . 'DAT' . idat . 'DISC'   = metdisc ;
      'SI' lmet ;
         B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met 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 ;
            nomdat = 'CHAINE' 'G' &idi ('+' &idi &jdi) ;
*               'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ;
            idat = '+' idat 1 ;
            B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ;
            B . 'DAT' . idat . 'DISC'   = metdisc ;
            'SI' lmet ;
               B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met 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  = 'LECT' ;
   B . 1 . 1 . 0  = 'LECT' 1 ;
*
vfonci = 'NLIN' gdisc _mt A B 'ERF1' methgau ;
*
rvfonci = 'MAXIMUM' ('RESULT' vfonci) ;
rvelemr = 'FLOTTANT' ('NBEL' _mt) ;
fac = '/' rvelemr rvfonci ;
*
vfonc  = '*' vfonci fac ;
*
'SI' faux ;
   rvfonc = 'MAXIMUM' ('RESULT' vfonc) ;
   tol = '/' rvelemr 10. ;
   test = ('EGA' rvfonc rvelemr tol) ;
   'SI' ('NON' test) ;
      'ERREUR' 5 ;
   'FINSI' ;         
'FINSI' ;
* 
'RESPRO' vfonc ;
*
'FINSI' ;
*
* End of procedure file DEADUTIL
*
'FINPROC' ;