Télécharger deadutil.procedur

Retour à la liste

* DEADUTIL  PROCEDUR  GOUNAND   25/11/24    21:15:02     12406          
************************************************************************
* 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'
                                             'QALI2' 'QEQU2' ;
'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 : 2018/01/22 : chgt nom composante hors diago G21 au lieu
*                           de G12
* HISTORIQUE : 2025/11/20 : muutualisation 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' 'QALI2' 'QEQU2') motcle) ;
*
'ARGUMENT' mail*'MAILLAGE' ;
*
lmotcle2 = 'MOTS' 'METR' 'DISG' 'METG' 'DENS' ;
*
lchad = FAUX ; lchp = FAUX ;
ldisg   = FAUX ;
lmg = FAUX ;
lmetdisc = faux ;
*
idim = 'VALEUR' 'DIME' ;
*
'REPETER' imotcle2 ;
   'ARGUMENT' motcle2/'MOT' ;
   'SI' ('NON' ('EXISTE' motcle2)) ;
      'QUITTER' imotcle2 ;
   'FINSI' ;
   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') ;
   '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' imotcle2 ;
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 = 'GAR1' ;
   'SINON' ;
      methgau = 'GAR2' ;
   '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 ;
      'ERRE' 1127 avec 'DEADUTIL' ;
  'FINS' ;
'FINSI' ;
 
*
'SI' ('EXIS' ('MOTS' 'QEQU' 'QEQU2') motcle) ;
   loi   = 'CHAI' 'QEQU' ;
   nocom = 'CHAI' 'EQUI' ;
'SINO' ;
   loi   = 'CHAI' 'QALI' ;
   nocom = 'CHAI' 'ALIG' ;
'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' lmet ;
         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' lmet ;
               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' ;
*
'SI' ('EXIS' ('MOTS' 'QEQU' 'QEQU2') motcle) ;
   tvfonc = 'TYPE' vfonc ;
   'SI' ('EGA' tvfonc 'CHPOINT') ;
      rvfonc = 'MAXI' ('RESU' vfonc) ;
   'SINO' ;
      vfonc2 = 'CHAN' vfonc ('MODE' ('EXTR' vfonc 'MAIL') 'THERMIQUE') 'GRAVITE' ;
      rvfonc = 'SOMM' ('EXTR' vfonc2 'VALE' 'SCAL') ;
   'FINS' ;
   rvelemr = 'FLOTTANT' ('NBEL' _mt) ;
   fac = '/' rvelemr rvfonc ;
   vfonc  = '*' vfonc fac ;
   'SI' ('EGA' motcle 'QEQU2') ;
* On remet les valeurs entre 0 et 1
      mvfonc = 'MASQ' vfonc 'SUPERIEUR' 1. ;
      pvfonc = 1. '-' mvfonc ;
      ivfonc = '**' vfonc -1 ;
      vfonc = '+' ('*' mvfonc ivfonc)  ('*' pvfonc vfonc) ;
   'FINS' ;
'FINS' ;
* On remet les valeurs entre 0 et 1
'SI' ('EGA' motcle 'QALI2') ;
   vfonc = '**' vfonc -1 ;
'FINS' ;
*
vfonc = 'NOMC' vfonc nocom ;
*
'RESPRO' vfonc ;
'FINSI' ;
*
*
* End of procedure file DEADUTIL
*
'FINPROC' ;
 
 

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