Télécharger dedu_cl1d.dgibi

Retour à la liste

* fichier : dedu_cl1d.dgibi
************************************************************************
************************************************************************
'OPTI' 'ECHO' 0 ;
************************************************************************
* NOM         : DEDU_CL1D
* DESCRIPTION : Adaptation de maillage avec 'DEDU' 'ADAP' sur une
*               couche limite exponentielle 1D (équation de
*               convection-diffusion à fort Péclet)
*               
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 26/03/2007, version initiale
* HISTORIQUE : v1, 26/03/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 !
************************************************************************
*
'SAUTER' 2 'LIGNE' ;
'MESSAGE' ' Execution de dedu_cl1d.dgibi' ;
'SAUTER' 2 'LIGNE' ;
*
*
*
interact= FAUX ;
graph   = FAUX ;
verbose = FAUX ;
complet = FAUX ;
debug   = FAUX ;
*
*BEGINPROCEDUR gmass
************************************************************************
* NOM         : GMASS
* DESCRIPTION : Une matrice de masse
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v2, 14/03/2006, mise à jour NLIN évolué
* VERSION    : v1, 13/05/2004, version initiale
* HISTORIQUE : v1, 13/05/2004, 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' GMASS ;
'ARGUMENT'     _mt*'MAILLAGE' ;
'ARGUMENT'     _smt/'MAILLAGE' ;
'ARGUMENT'   gdisc*'MOT     ' ;
'ARGUMENT'   lnomt/'LISTMOTS' ;
'SI' ('NON' ('EXISTE' lnomt)) ;
   'ARGUMENT'    nomt*'MOT     ' ;
   lnomt = 'MOTS' nomt ;
'FINSI' ;   
'ARGUMENT'   disct*'MOT     ' ;
'ARGUMENT'   lnomq/'LISTMOTS' ;
'SI' ('NON' ('EXISTE' lnomq)) ;
   'ARGUMENT'    nomq*'MOT     ' ;
   lnomq = 'MOTS' nomq ;
'FINSI' ;   
'ARGUMENT'   discq*'MOT     ' ;
'ARGUMENT' coef/'FLOTTANT' ;
   'SI' ('NON' ('EXISTE' coef)) ;
      'ARGUMENT' coef2/'CHPOINT ' ;
      'SI' ('NON' ('EXISTE' coef2)) ;
         'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
      'SINON' ;
         coef = coef2 ;
         'ARGUMENT' discc*'MOT     ' ;
      'FINSI' ;                  
   'SINON' ;
      discc = 'CSTE' ;
   'FINSI' ;
'ARGUMENT' methgau/'MOT     ' ;
   'SI' ('NON' ('EXISTE' methgau)) ;
      methgau = 'GAU7' ;
   'FINSI' ;
'ARGUMENT' chpop/'CHPOINT' ;
'ARGUMENT' chpod/'CHPOINT' ;
*
   vdim = 'VALEUR' 'DIME' ;
   vmod = 'VALEUR' 'MODE' ;
   idim = 0 ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
      idim = 2 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
      idim = 2 ;
      iaxi = VRAI ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
      idim = 3 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('EGA' vdim 1) ;
      idim = 1 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('EGA' idim 0) ;
      'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
   'FINSI' ;
   'SI' iaxi ;
      dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
   'FINSI' ;
   dlnomt = 'DIME' lnomt ; dlnomq = 'DIME' lnomq ;
   'SI' ('NEG' dlnomt dlnomq) ;
    'ERREUR' ('CHAINE' 'Pas le meme nombre dincos primales et duales');
   'FINSI' ;
*   numop  = 1 ;
   numop  = dlnomt ;
   numder = idim ;
   numvar = dlnomt ;
   numdat = 1 ;
   numcof = 1 ;
*
   A = ININLIN numop numvar numdat numcof numder ;
   'REPETER' iilnomt dlnomt ;
      ilnomt = &iilnomt ;
      A . 'VAR' . ilnomt . 'NOMDDL' = 'MOTS' ('EXTRAIRE' lnomt ilnomt) ;
      A . 'VAR' . ilnomt . 'DISC'   = disct ;
      'SI' ('EXISTE' chpop) ;
         A . 'VAR' . ilnomt . 'VALEUR'   = chpop ;
      'FINSI' ;
   'FIN' iilnomt ;
   A . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
   A . 'DAT' . 1 . 'DISC'   = discc ;
   A . 'DAT' . 1 . 'VALEUR' = coef ;
   A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
   A . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
*
   'REPETER' iilnomt dlnomt ;
      ilnomt = &iilnomt ;
      A . ilnomt . ilnomt . 0 = 'LECT' 1 ;
   'FIN' iilnomt ;      
*
   'SI' iaxi ;
      numdat = 1 ;
      numcof = 1 ;
   'SINON' ;      
      numdat = 0 ;
      numcof = 0 ;
   'FINSI' ;      
   B = ININLIN numop numvar numdat numcof numder ;   
   'REPETER' iilnomq dlnomq ;
      ilnomq = &iilnomq ;
      B . 'VAR' . ilnomq . 'NOMDDL' = 'MOTS' ('EXTRAIRE' lnomq ilnomq) ;
      B . 'VAR' . ilnomq . 'DISC'   = discq ;
      'SI' ('EXISTE' chpod) ;
         B . 'VAR' . ilnomq . 'VALEUR'   = chpod ;
      'FINSI' ;
   'FIN' iilnomq ;      
*
   'SI' iaxi ;
      B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      B . 'DAT' . 1 . 'DISC'   = gdisc ;
      B . 'DAT' . 1 . 'VALEUR' = dprmt ;
      B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
      B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
   'FINSI' ;
   'SI' iaxi ;
      'REPETER' iilnomq dlnomq ;
         ilnomq = &iilnomq ;
         B . ilnomq . ilnomq . 0 = 'LECT' 1 ;
      'FIN' iilnomq ;      
   'SINON' ;     
      'REPETER' iilnomq dlnomq ; 
         ilnomq = &iilnomq ;
         B . ilnomq . ilnomq . 0 = 'LECT' ;
      'FIN' iilnomq ;
   'FINSI' ;      
*
   'SI' ('EXISTE' _smt) ;
       mgmass = 'NLIN' gdisc _mt _smt A B methgau ;
   'SINON' ;       
       mgmass = 'NLIN' gdisc _mt A B methgau ;
   'FINSI' ;       
*
'RESPRO' mgmass ;
'FINPROC' ;
*
* End of procedure file GMASS
*
*ENDPROCEDUR gmass
*BEGINPROCEDUR glapn
************************************************************************
* NOM         : GLAPN
* DESCRIPTION : Un laplacien scalaire 
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v2, 14/03/2006, mise à jour NLIN évolué
* VERSION    : v1, 13/05/2004, version initiale
* HISTORIQUE : v1, 13/05/2004, 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' GLAPN ;
'ARGUMENT'     _mt*'MAILLAGE' ;
'ARGUMENT'   gdisc*'MOT     ' ;
'ARGUMENT'    nomt*'MOT     ' ;
'ARGUMENT'   disct*'MOT     ' ;
'ARGUMENT'    nomq*'MOT     ' ;
'ARGUMENT'   discq*'MOT     ' ;
'ARGUMENT' coef/'FLOTTANT' ;
   'SI' ('NON' ('EXISTE' coef)) ;
      'ARGUMENT' coef2/'CHPOINT ' ;
      'SI' ('NON' ('EXISTE' coef2)) ;
         'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
      'SINON' ;
         coef = coef2 ;
         'ARGUMENT' discc*'MOT     ' ;
      'FINSI' ;                  
   'SINON' ;
      discc = 'CSTE' ;
   'FINSI' ;            
   'ARGUMENT' methgau/'MOT     ' ;
   'SI' ('NON' ('EXISTE' methgau)) ;
      methgau = 'GAU7' ;
   'FINSI' ;      
'ARGUMENT' chpop/'CHPOINT' ;
'ARGUMENT' chpod/'CHPOINT' ;
*
   vdim = 'VALEUR' 'DIME' ;
   vmod = 'VALEUR' 'MODE' ;
   idim = 0 ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
      idim = 2 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
      idim = 2 ;
      iaxi = VRAI ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
      idim = 3 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('EGA' vdim 1) ;
      idim = 1 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('EGA' idim 0) ;
      'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
   'FINSI' ;
   'SI' iaxi ;
      dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
   'FINSI' ;      
* Test bête...
   'SI' ('EGA' ('TYPE' coef) 'CHPOINT ') ;
      mincoef = 'MINIMUM' coef ;
   'SINON' ;
      mincoef = coef ;
   'FINSI' ;            
   'SI' ('<' mincoef 0.D0) ;
      'ERREUR' 'Le coef (une viscosité) doit etre positive' ;
   'FINSI' ;      
*
   'SI' iaxi ;
      lcoef = 'MOTS' 'NURR' 'NUZZ' ;
   'SINON' ;
      'SI' ('EGA' idim 2) ;
         lcoef = 'MOTS' 'NUXX' 'NUYY' ;
      'SINON' ;
         lcoef = 'MOTS' 'NUXX' 'NUYY' 'NUZZ' ;
      'FINSI' ;
   'FINSI' ;      
*
   ltens = FAUX ;
   'SI' ('EGA' ('TYPE' coef) 'CHPOINT') ;
      ncomp = 'DIME' ('EXTRAIRE' coef 'COMP') ;
      'SI' ('EGA' ncomp idim) ;
         ltens = VRAI ;
      'FINSI' ;
   'FINSI' ;
*
   tcoef = 'TABLE' ;
   'SI' ltens ;
      'REPETER' iidim idim ;
         tcoef . &iidim = 'EXCO' ('EXTRAIRE' lcoef &iidim) coef ;
      'FIN' iidim ;
   'SINON' ;               
      'REPETER' iidim idim ;
         tcoef . &iidim = coef ;
      'FIN' iidim ;
   'FINSI' ;
*      
   numop  = idim ;
   numder = idim ;
   mmt = 'MOTS' nomt ;
   mmq = 'MOTS' nomq ;
   numvar = 1 ;
   numdat = idim ;
   numcof = idim ;
*
   A = ININLIN numop numvar numdat numcof numder ;   
   A . 'VAR' . 1 . 'NOMDDL' = mmt ;
   A . 'VAR' . 1 . 'DISC'   = disct ;
   'SI' ('EXISTE' chpop) ;
      A . 'VAR' . 1 . 'VALEUR'   = chpop ;
   'FINSI' ;   
   'REPETER' iidim idim ;
      A . 'DAT' . &iidim . 'NOMDDL' = 'MOTS' 'SCAL' ;
      A . 'DAT' . &iidim . 'DISC'   = discc ;
      A . 'DAT' . &iidim . 'VALEUR' = tcoef . &iidim ;
      A . 'COF' . &iidim . 'COMPOR' = 'IDEN' ;
      A . 'COF' . &iidim . 'LDAT'   = 'LECT' &iidim ;
   'FIN' iidim ;
*
   'REPETER' iidim idim ;
      A . &iidim . 1 . &iidim = 'LECT' &iidim ;
   'FIN' iidim ;      
*
   'SI' iaxi ;
      numdat = 1 ;
      numcof = 1 ;
   'SINON' ;      
      numdat = 0 ;
      numcof = 0 ;
   'FINSI' ;      
*
   B = ININLIN numop numvar numdat numcof numder ;   
   B . 'VAR' . 1 . 'NOMDDL' = mmq ;
   B . 'VAR' . 1 . 'DISC'   = discq ;
   'SI' ('EXISTE' chpod) ;
      B . 'VAR' . 1 . 'VALEUR'   = chpod ;
   'FINSI' ;   
   'SI' iaxi ;
      B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      B . 'DAT' . 1 . 'DISC'   = gdisc ;
      B . 'DAT' . 1 . 'VALEUR' = dprmt ;
      B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
      B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
   'FINSI' ;
*
   'REPETER' iidim idim ;
      'SI' iaxi ;      
         B . &iidim . 1 . &iidim = 'LECT' 1 ;
      'SINON' ;      
         B . &iidim . 1 . &iidim = 'LECT' ;
      'FINSI' ;      
   'FIN' iidim ;      
*
   mglapn = 'NLIN' gdisc _mt A B methgau ;
* Integration par parties
   mglapn = '*' mglapn -1.D0 ;
*
'RESPRO' mglapn ;
'FINPROC' ;
*
* End of procedure file GLAPN
*
*ENDPROCEDUR glapn
*BEGINPROCEDUR gugrad
************************************************************************
* NOM         : GUGRAD
* DESCRIPTION : U . grad
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 13/05/2004, version initiale
* HISTORIQUE : v1, 13/05/2004, 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' GUGRAD ;
'ARGUMENT'     _mt*'MAILLAGE' ;
'ARGUMENT'   gdisc*'MOT     ' ;
'ARGUMENT'    nomp*'MOT     ' ;
'ARGUMENT'   discp*'MOT     ' ;
'ARGUMENT'    nomd*'MOT     ' ;
'ARGUMENT'   discd*'MOT     ' ;
'ARGUMENT'    vtot*'CHPOINT ' ;
'ARGUMENT'    vcomp*'LISTMOTS' ;
'ARGUMENT'   discv*'MOT     ' ;
'ARGUMENT' coef/'FLOTTANT' ;
   'SI' ('NON' ('EXISTE' coef)) ;
      'ARGUMENT' coef2/'CHPOINT ' ;
      'SI' ('NON' ('EXISTE' coef2)) ;
         'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
      'SINON' ;
         coef = coef2 ;
         'ARGUMENT' discc*'MOT     ' ;
      'FINSI' ;                  
   'SINON' ;
      discc = 'CSTE' ;
   'FINSI' ;            
'ARGUMENT' methgau/'MOT     ' ;
   'SI' ('NON' ('EXISTE' methgau)) ;
      methgau = 'GAU7' ;
   'FINSI' ;      
'ARGUMENT' chpop/'CHPOINT' ;
'ARGUMENT' chpod/'CHPOINT' ;
*
   vdim = 'VALEUR' 'DIME' ;
   vmod = 'VALEUR' 'MODE' ;
   idim = 0 ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
      idim = 2 ;
      iaxi = FAUX ;
*      Passé en argument désormais      
*      vcomp = 'MOTS' 'UX' 'UY' ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
      idim = 2 ;
      iaxi = VRAI ;
*      vcomp = 'MOTS' 'UR' 'UZ' ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
      idim = 3 ;
      iaxi = FAUX ;
*      vcomp = 'MOTS' 'UX' 'UY' 'UZ' ;
   'FINSI' ;
   'SI' ('EGA' vdim 1) ;
      idim = 1 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('EGA' idim 0) ;
      'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
   'FINSI' ;
   'SI' iaxi ;
      dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
   'FINSI' ;      
*
   numop  = 1 ;
   numder = idim ;
   mmp = 'MOTS' nomp ;
   mmd = 'MOTS' nomd ;
   numvar = 1 ;
   numdat = idim ;
   numcof = idim ;
*
   A = ININLIN numop numvar numdat numcof numder ;   
   A . 'VAR' . 1 . 'NOMDDL' = mmp ;
   A . 'VAR' . 1 . 'DISC'   = discp ;
   'SI' ('EXISTE' chpop) ;
      A . 'VAR' . 1 . 'VALEUR'   = chpop ;
   'FINSI' ;   
   'REPETER' iidim idim ;
      nomco = 'EXTRAIRE' vcomp &iidim ;
      A . 'DAT' . &iidim . 'NOMDDL' = 'MOTS' nomco ;
      A . 'DAT' . &iidim . 'DISC'   = discv ;
*      A . 'DAT' . &iidim . 'VALEUR' = 'EXCO' nomco 'NOID' vtot nomco ;
      A . 'DAT' . &iidim . 'VALEUR' = 'EXCO' nomco vtot nomco ;
*      
      A . 'COF' . &iidim . 'COMPOR' = 'IDEN' ;
      A . 'COF' . &iidim . 'LDAT'   = 'LECT' &iidim ;
   'FIN' iidim ;      
*
   'REPETER' iidim idim ;
      A . 1 . 1 . &iidim = 'LECT' &iidim ;
   'FIN' iidim ;      
*
   numvar = 1 ;
   'SI' iaxi ;
      numdat = 2 ;
      numcof = 2 ;
   'SINON' ;      
      numdat = 1 ;
      numcof = 1 ;
   'FINSI' ;      
*
   B = ININLIN numop numvar numdat numcof numder ;   
   B . 'VAR' . 1 . 'NOMDDL' = mmd ;
   B . 'VAR' . 1 . 'DISC'   = discd ;
   'SI' ('EXISTE' chpod) ;
      B . 'VAR' . 1 . 'VALEUR'   = chpod ;
   'FINSI' ;   
*   
   B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
   B . 'DAT' . 1 . 'DISC'   = discc ;
   B . 'DAT' . 1 . 'VALEUR' = coef ;
   B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
   B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
*
   'SI' iaxi ;
      B . 'DAT' . 2 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      B . 'DAT' . 2 . 'DISC'   = gdisc ;
      B . 'DAT' . 2 . 'VALEUR' = dprmt ;
      B . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
      B . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
   'FINSI' ;
*
   'SI' iaxi ;      
      B . 1 . 1 . 0 = 'LECT' 1 2 ;
   'SINON' ;      
      B . 1 . 1 . 0 = 'LECT' 1 ;
   'FINSI' ;      
*
   mgugrad = 'NLIN' gdisc _mt A B methgau ;
*
'RESPRO' mgugrad ;
'FINPROC' ;
*
* End of procedure file GUGRAD
*
*ENDPROCEDUR gugrad
*BEGINPROCEDUR gdecent
************************************************************************
* NOM         : GDECENT
* DESCRIPTION : Décentrement
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 13/05/2004, version initiale
* HISTORIQUE : v1, 13/05/2004, 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' GDECENT ;
'ARGUMENT' imeth*'ENTIER' ;
'ARGUMENT'     _mt*'MAILLAGE' ;
'ARGUMENT'   gdisc*'MOT     ' ;
'ARGUMENT'    nomp*'MOT     ' ;
'ARGUMENT'   discp*'MOT     ' ;
'ARGUMENT'    nomd*'MOT     ' ;
'ARGUMENT'   discd*'MOT     ' ;
'ARGUMENT'    vtot*'CHPOINT ' ;
'ARGUMENT'    vcomp*'LISTMOTS' ;
'ARGUMENT'   discv*'MOT     ' ;
'ARGUMENT'     rho*'FLOTTANT' ;
'ARGUMENT'      nu*'FLOTTANT' ;
'ARGUMENT'     Pec*'FLOTTANT' ;
'ARGUMENT' methgau/'MOT     ' ;
   'SI' ('NON' ('EXISTE' methgau)) ;
      methgau = 'GAU7' ;
   'FINSI' ;      
'ARGUMENT' chpop/'CHPOINT' ;
'ARGUMENT' chpod/'CHPOINT' ;
*
   vdim = 'VALEUR' 'DIME' ;
   vmod = 'VALEUR' 'MODE' ;
   idim = 0 ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
      idim = 2 ;
      iaxi = FAUX ;
*      Passé en argument désormais      
*      vcomp = 'MOTS' 'UX' 'UY' ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
      idim = 2 ;
      iaxi = VRAI ;
*      vcomp = 'MOTS' 'UR' 'UZ' ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
      idim = 3 ;
      iaxi = FAUX ;
*      vcomp = 'MOTS' 'UX' 'UY' 'UZ' ;
   'FINSI' ;
   'SI' ('EGA' vdim 1) ;
      idim = 1 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('EGA' idim 0) ;
      'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
   'FINSI' ;
   'SI' iaxi ;
      dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
   'FINSI' ;      
*
   mdumm = 'MOTS' 'DUMM' ;
   numop  = 1 ;
   numder = idim ;
   mmp = 'MOTS' nomp ;
   mmd = 'MOTS' nomd ;
   numvar = 1 ;
   numdat = '+' idim 3 ;
   numcof = idim ;
   lisdat = 'LECT' 1 PAS 1 ('+' idim 3) ;
*
   A = ININLIN numop numvar numdat numcof numder ;   
   A . 'VAR' . 1 . 'NOMDDL' = mmp ;
   A . 'VAR' . 1 . 'DISC'   = discp ;
   'SI' ('EXISTE' chpop) ;
      A . 'VAR' . 1 . 'VALEUR'   = chpop ;
   'FINSI' ;
   idat = 0 ;
   idat = '+' idat 1 ;
   A . 'DAT' . idat . 'NOMDDL' = mdumm  ;
   A . 'DAT' . idat . 'DISC'   = 'CSTE' ;
   A . 'DAT' . idat . 'VALEUR' = rho    ;
   idat = '+' idat 1 ;
   A . 'DAT' . idat . 'NOMDDL' = mdumm  ;
   A . 'DAT' . idat . 'DISC'   = 'CSTE' ;
   A . 'DAT' . idat . 'VALEUR' = nu    ;
   'REPETER' iidim idim ;
      nomco = 'EXTRAIRE' vcomp &iidim ;
      idat = '+' idat 1 ;
      A . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomco ;
      A . 'DAT' . idat . 'DISC'   = discv ;
*      A . 'DAT' . idat . 'VALEUR' = 'EXCO' nomco 'NOID' vtot nomco ;
      A . 'DAT' . idat . 'VALEUR' = 'EXCO' nomco vtot nomco ;
   'FIN' iidim ;
   idat = '+' idat 1 ;
   A . 'DAT' . idat . 'NOMDDL' = mdumm  ;
   A . 'DAT' . idat . 'DISC'   = 'CSTE' ;
   A . 'DAT' . idat . 'VALEUR' = Pec    ;
*
   icof = 0 ;
   'REPETER' iidim idim ;
      icof = '+' icof 1 ;
      A . 'COF' . icof . 'COMPOR' = 'CHAINE' 'MUSTAB' imeth &iidim ;
      A . 'COF' . icof . 'LDAT'   = lisdat ;
   'FIN' iidim ;         
*
   'REPETER' iidim idim ;
      A . 1 . 1 . &iidim = 'LECT' &iidim ;
   'FIN' iidim ;      
*
   numvar = 1 ;
   'SI' iaxi ;
      numdat = '+' idim 4 ;
      numcof = '+' idim 1 ;
   'SINON' ;      
      numdat = '+' idim 3 ;
      numcof = idim ;
   'FINSI' ;      
*
   B = ININLIN numop numvar numdat numcof numder ;   
   B . 'VAR' . 1 . 'NOMDDL' = mmd ;
   B . 'VAR' . 1 . 'DISC'   = discd ;
   'SI' ('EXISTE' chpod) ;
      B . 'VAR' . 1 . 'VALEUR'   = chpod ;
   'FINSI' ;   
   idat = 0 ;
   idat = '+' idat 1 ;
   B . 'DAT' . idat . 'NOMDDL' = mdumm  ;
   B . 'DAT' . idat . 'DISC'   = 'CSTE' ;
   B . 'DAT' . idat . 'VALEUR' = rho    ;
   idat = '+' idat 1 ;
   B . 'DAT' . idat . 'NOMDDL' = mdumm  ;
   B . 'DAT' . idat . 'DISC'   = 'CSTE' ;
   B . 'DAT' . idat . 'VALEUR' = nu    ;
   'REPETER' iidim idim ;
      nomco = 'EXTRAIRE' vcomp &iidim ;
      idat = '+' idat 1 ;
      B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomco ;
      B . 'DAT' . idat . 'DISC'   = discv ;
*      A . 'DAT' . idat . 'VALEUR' = 'EXCO' nomco 'NOID' vtot nomco ;
      B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomco vtot nomco ;
   'FIN' iidim ;
   idat = '+' idat 1 ;
   B . 'DAT' . idat . 'NOMDDL' = mdumm  ;
   B . 'DAT' . idat . 'DISC'   = 'CSTE' ;
   B . 'DAT' . idat . 'VALEUR' = Pec    ;
*
   icof = 0 ;
   'REPETER' iidim idim ;
      icof = '+' icof 1 ;
      B . 'COF' . icof . 'COMPOR' = 'CHAINE' 'MUSTAB' imeth &iidim ;
      B . 'COF' . icof . 'LDAT'   = lisdat ;
   'FIN' iidim ;         
*
   'SI' iaxi ;
      idat = '+' idat 1 ;
      B . 'DAT' . idat . 'NOMDDL' = 'MOTS' 'SCAL' ;
      B . 'DAT' . idat . 'DISC'   = gdisc ;
      B . 'DAT' . idat . 'VALEUR' = dprmt ;
      icof = '+' icof 1 ;
      B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
      B . 'COF' . icof . 'LDAT'   = 'LECT' idat ;
   'FINSI' ;
*
   'SI' iaxi ;      
      'REPETER' iidim idim ;
         B . 1 . 1 . &iidim = 'LECT' &iidim icof ;
      'FIN' iidim ;      
   'SINON' ;      
      'REPETER' iidim idim ;
         B . 1 . 1 . &iidim = 'LECT' &iidim ;
      'FIN' iidim ;      
   'FINSI' ;      
*
   mgdecent = 'NLIN' gdisc _mt A B methgau ;
*
'RESPRO' mgdecent ;
'FINPROC' ;
*
* End of procedure file GDECENT
*
*ENDPROCEDUR gdecent
*BEGINPROCEDUR dessevol
************************************************************************
* NOM         : DESSEVOL
* DESCRIPTION : Dessine des évolutions : choisit automatiquement
*               les options, marqueurs, couleurs...
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 16/11/2004, version initiale
* HISTORIQUE : v1, 16/11/2004, 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' DESSEVOL ;
'ARGUMENT' evtot*'EVOLUTION' ;
'ARGUMENT' tabt*'TABLE' ;
'ARGUMENT' tit*'MOT' ;
'ARGUMENT' tix*'MOT' ;
'ARGUMENT' tiy*'MOT' ;
'ARGUMENT' lnclk/'LOGIQUE' ;
'ARGUMENT' nb/'ENTIER' ;
*
'SI' ('NON' ('EXISTE' lnclk)) ;
   lnclk = FAUX ;
'FINSI' ;   
*
'SI' ('NON' ('EXISTE' nb)) ;
   nb = 3 ;
'FINSI' ;   
*
nt  = 'DIME' tabt ;
nev = 'DIME' evtot ;
*
* Attention, dans evtot, il y a une évolution avec des noms de points ?
*
*'SI' ('NEG' nev nt) ;
*   cherr = 'CHAINE' 'Evolution and title table : not same dim.' ;
*   'ERREUR' cherr ;
*'FINSI' ;
*
tev = 'TABLE' ;
tev . 'TITRE' = tabt ;
*
toto = 'TABLE' ;
*
lcoul = 'MOTS' 'TURQ' 'VERT' 'JAUN' 'ROSE' 'ROUG' 'BLEU' ;
lmarq = 'MOTS' 'TRIB' 'TRIA' 'LOSA' 'CARR' 'ETOI' 'PLUS' 'CROI' ;
ltirr = 'MOTS' 'TIRR' 'TIRC' 'TIRL' 'TIRM' ;
*
'SI' ('EGA' nb 0) ;
   ev2 = evtot ;
'SINON' ;
   icou = 0 ;
   'REPETER' iev nev ;
      ii = &iev ;
      evi = 'EXTRAIRE' evtot 'COUR' ii ;
      'SI' ('NEG' ('TYPE' ('EXTRAIRE' evi 'ORDO')) 'LISTMOTS') ;
         icou = '+' icou 1 ;
      'FINSI' ;         
*      ii2 = '/' ('+' ii 1) 2 ;
*      ci  = EXMOMOD lcoul ii2 ;
*      ci  = EXMOMOD lcoul ii ;
      ci  = EXMOMOD lcoul icou ;
      APPEND toto 'EVOLUTION' ('COULEUR' evi ci) ;
   'FIN' iev ;
   ev2 = toto . 'EVOLUTION' ;
'FINSI' ;
*      
'REPETER' iev nev ;
   ii = &iev ;
   mi = EXMOMOD lmarq ii ;
   ti = EXMOMOD ltirr ii ;
   'SI' ('>' nb 2) ;
      tev . ii = 'CHAINE' 'MARQ ' mi ' ' ti ;
   'FINSI' ;      
   'SI' ('>' nb 1) ;
      tev . ii = 'CHAINE' 'MARQ ' mi ;
   'FINSI' ;      
'FIN' iev ;   
*
'SI' lnclk ;
   'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
   'NCLK' ;
'SINON' ;   
   'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev ;
'FINSI' ;   
*
* End of procedure file DESSEVOL
*
'FINPROC' ;
*ENDPROCEDUR dessevol
*BEGINPROCEDUR exmomod
************************************************************************
* NOM         : EXMOMOD
* DESCRIPTION : Extraction d'un mot d'un listmots
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 23/06/2003, version initiale
* HISTORIQUE : v1, 23/06/2003, 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' EXMOMOD ;
'ARGUMENT' lm*'LISTMOTS' i*'ENTIER' ;
j = 'DIME' lm ;
k = '+' (MODULO ('-' i 1) j) 1 ;
lemot = 'EXTRAIRE' lm k ;
* Usage de l'opérateur text pour éviter que lemot
* ne soit interprété comme un opérateur
'RESPRO' 'TEXTE' lemot ;
*
* End of procedure file EXMOMOD
*
'FINPROC' ;
*ENDPROCEDUR exmomod
*BEGINPROCEDUR modulo
************************************************************************
* NOM         : MODULO
* DESCRIPTION : Calcule un entier modulo un autre...
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 15/10/2002, version initiale
* HISTORIQUE : v1, 15/10/2002, 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' MODULO ;
'ARGUMENT' i*'ENTIER' j*'ENTIER' ;
'SI' ('EGA' j 0) ;
  'MESSAGE' 'Impossible de faire modulo 0' ;
  'ERREUR' 5 ;
'SINON' ;
  k=i '/' j ;
  mod=i '-' ( k '*'j ) ;
  'RESPRO' mod ;
'FINSI' ;
*
* End of procedure file MODULO
*
'FINPROC' ;
*ENDPROCEDUR modulo
*BEGINPROCEDUR append
************************************************************************
* NOM         : APPEND
* DESCRIPTION : Rajoute :
*               - un entier à un listentier
*               - un réel   à un listreel
*               - un objet (liste, evolution, matrice ou chpoint)
*                 à un indice de table ('MOT' ou 'ENTIER')
*                    * si l'indice n'existe pas
*                    * 'ET' si l'indice existe 
*                
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 10/09/2004, version initiale
* HISTORIQUE : v1, 10/09/2004, 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' APPEND ;
'ARGUMENT' tab/'TABLE' ;
'SI' ('EXISTE' tab) ;
   'ARGUMENT' itab/'MOT' ;
   'SI' ('NON' ('EXISTE' itab)) ;
      'ARGUMENT' itab*'ENTIER' ;
   'FINSI' ;      
   lobj = FAUX ;
   'SI' ('NON' lobj) ;
      'ARGUMENT' lr/'LISTREEL' ;
      'SI' ('EXISTE' lr) ;
         obj = lr ; lobj = VRAI ;
      'FINSI' ;
   'FINSI' ;               
   'SI' ('NON' lobj) ;
      'ARGUMENT' le/'LISTENTI' ;
      'SI' ('EXISTE' le) ;
         obj = le ; lobj = VRAI ;
      'FINSI' ;
   'FINSI' ;               
   'SI' ('NON' lobj) ;
      'ARGUMENT' lev/'EVOLUTION' ;
      'SI' ('EXISTE' lev) ;
         obj = lev ; lobj = VRAI ;
      'FINSI' ;
   'FINSI' ;               
   'SI' ('NON' lobj) ;
      'ARGUMENT' lm/'MAILLAGE' ;
      'SI' ('EXISTE' lm) ;
         obj = lm ; lobj = VRAI ;
      'FINSI' ;
   'FINSI' ;               
   'SI' ('NON' lobj) ;
      'ARGUMENT' chpo/'CHPOINT' ;
      'SI' ('EXISTE' chpo) ;
         obj = chpo ; lobj = VRAI ;
      'FINSI' ;
   'FINSI' ;               
   'SI' ('NON' lobj) ;
      'ARGUMENT' rig/'RIGIDITE' ;
      'SI' ('EXISTE' rig) ;
         obj = rig ; lobj = VRAI ;
      'FINSI' ;
   'FINSI' ;               
   'SI' ('NON' lobj) ;
      'ARGUMENT' matk/'MATRIK' ;
      'SI' ('EXISTE' matk) ;
         obj = matk ; lobj = VRAI ;
      'FINSI' ;
   'FINSI' ;
   'SI' ('NON' lobj) ;
      cherr = 'CHAINE'
       'Il faut fournir un objet liste, evolution, matrice ou chpoint.'
        ; 
      'ERREUR' cherr ;
   'FINSI' ;      
   'SI' ('EXISTE' tab itab) ;
      'SI' ('EGA' ('TYPE' obj) 'CHPOINT') ;
         tab . itab = '+' (tab . itab) obj ;
      'SINON' ;         
         tab . itab = 'ET' (tab . itab) obj ;
      'FINSI' ;         
   'SINON' ;
      tab . itab = obj ;
   'FINSI' ;
   'RESPRO' tab ;      
'FINSI' ;   
'ARGUMENT' lenti/'LISTENTI' ;
'ARGUMENT' lreel/'LISTREEL' ;
'SI' ('EXISTE' lenti) ;
   'ARGUMENT' enti*'ENTIER' ;
   lenti = 'ET' lenti ('LECT' enti) ;
   'RESPRO' lenti ;
'FINSI' ;   
'SI' ('EXISTE' lreel) ;
   'ARGUMENT' reel*'FLOTTANT' ;
   lreel = 'ET' lreel ('PROG' reel) ;
   'RESPRO' lreel ;
'FINSI' ;   
*
* End of procedure file APPEND
*
'FINPROC' ;
*ENDPROCEDUR append
*BEGINPROCEDUR histo
************************************************************************
* NOM         : HISTO
* DESCRIPTION : Construit une evolution représentant un histogramme
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 13/09/2004, version initiale
* HISTORIQUE : v1, 13/09/2004, 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' HISTO ;
'ARGUMENT' lx*'LISTREEL' ;
'ARGUMENT' ly*'LISTREEL' ;
*
dlx = 'DIME' lx ;
dly = 'DIME' ly ;
*
'SI' ('NEG' dly ('-' dlx 1)) ;
   cherr = 'CHAINE' 'Dimension des arguments incorrecte' ;
   'MESSAGE' ('CHAINE' 'Dime lx=' dlx  ' Dime ly=' dly) ;
   'ERREUR' cherr ;
'FINSI' ;
*
lxn = 'PROG' ;
lyn = 'PROG' ;
*
'REPETER' ii dly ;
   vx  = 'EXTRAIRE' lx &ii ;
   vxp = 'EXTRAIRE' lx ('+' &ii 1) ;
   vy  = 'EXTRAIRE' ly &ii ;
   pvx = 'PROG' vx ; pvxp = 'PROG' vxp ;
   pvy = 'PROG' vy ; pv0  = 'PROG' 0.D0 ;
   lxn = lxn 'ET' pvx 'ET' pvx 'ET' pvxp 'ET' pvxp ;
   lyn = lyn 'ET' pv0 'ET' pvy 'ET' pvy 'ET' pv0 ;
'FIN' ii ;
evhist = 'EVOL' 'MANU' lxn lyn ;   
'RESPRO' evhist ;
*
* End of procedure file HISTO
*
'FINPROC' ;
*ENDPROCEDUR histo
*
* Calcul de la solution exacte
*
'DEBPROC' SOLEX ;
'ARGUMENT' nu*'FLOTTANT' ;
'ARGUMENT' mesh*'MAILLAGE' ;
*
   ct = '/' 1.D0 nu ;
   deno = '-' 1. ('EXP' ct) ;
   nume = 'EXP' ('*' ('COORDONNEE' 1 mesh) ct) ;
   nume = '*' nume -1. ;
   nume = '+' nume 1. ;
   vfon = '*' nume ('/' 1. deno) ;
   vfon = 'NOMC' 'T' vfon ;
*   
'RESPRO' vfon ;
'FINPROC' ;
*
* Calcul de la solution approchée
*
'DEBPROC' SOLAPP ;
'ARGUMENT' _mt*'MAILLAGE' ;
'ARGUMENT' tem*'CHPOINT' ;
*
   mlap = GLAPN _mt discg 'T' discg 'Q' discg iPe ;
   mlap = '*' mlap -1.D0 ;
   flap = GLAPN _mt discg 'T' discg 'Q' discg iPe tem ;
   msou = GUGRAD _mt discg 'T' discg 'Q' discg v1 mxpri discg 1. ;
   fsou = GUGRAD _mt discg 'T' discg 'Q' discg v1 mxpri discg 1. tem ;
   fsou = '*' fsou -1.D0 ;
   'SI' lsupg ;
      mdec = GDECENT 2 _mt discg 'T' discg 'Q' discg v1 mxpri discg 
                     csupg iPe 2.D0 ; 
      fdec = GDECENT 2 _mt discg 'T' discg 'Q' discg v1 mxpri discg 
                     csupg iPe 2.D0 tem ;
      fdec = '*' fdec -1.D0 ;                  
   'FINSI' ;
*   
   ftot = flap '+' fsou ;
*
   mblo = 'BLOQUE' 'T' (p0 'ET' p1) ;
   mtot = mlap 'ET' msou 'ET' mblo ;
   'SI' lsupg ;
      ftot = ftot '+' fdec ;
      mtot = mtot 'ET' mdec ;
   'FINSI' ;
   sol = 'RESOUD' mtot ftot ;
   dtem = 'EXCO' mtpri sol ;
   frea = 'REACTION' mblo sol ;
   'RESPRO' dtem frea ;
'FINPROC' ;
*
* Calcul de la métrique : on utilise la valeur de Laplacien T
* (production locale d'entropie) pour réaliser l'adaptation
*
'DEBPROC' TGDENT ;
'ARGUMENT' _mt*'MAILLAGE' ;
'ARGUMENT' tem*'CHPOINT' ;
'ARGUMENT' beta*'FLOTTANT' ;
* Tracé des forces
* Calcul de la dérivée seconde de T
   flap = GLAPN _mt discg 'T' discg 'Q' discg iPe tem ;
   fsou = GUGRAD _mt discg 'T' discg 'Q' discg v1 mxpri discg 1. tem ;
   fsou = '*' fsou -1.D0 ;
   fdec = GDECENT 2 _mt discg 'T' discg 'Q' discg v1 mxpri discg 
                  csupg iPe 2.D0 tem ;
   fdec = '*' fdec -1.D0 ;                  
   'SI' ('NON' lsupg) ;
      fdec = '*' fdec 0.D0 ;
   'FINSI' ;
   'SI' (graph 'ET' debug) ;
      evl  = 'EVOL' 'CHPO' ('+' flap cq) 'Q' mt ;
      evs  = 'EVOL' 'CHPO' ('+' fsou cq) 'Q' mt ;
      evd  = 'EVOL' 'CHPO' ('+' fdec cq) 'Q' mt ;
      evb  = 'EVOL' 'CHPO' ('+' fblo cq) 'Q' mt ;
      evt  = evl 'ET' evs 'ET' evd 'ET' evb ;
      tabt = 'TABLE' ;
      tabt . 1 = 'CHAINE' 'Laplacien' ;
      tabt . 2 = 'CHAINE' 'Convection' ;
      tabt . 3 = 'CHAINE' 'Decentrement' ;
      tabt . 4 = 'CHAINE' 'Blocage' ;
      tit = 'CHAINE' 'Forces integrees' ;
      titx = 'CHAINE' 'x' ;
      tity = 'CHAINE' 'F' ;
      dessevol evt tabt tit titx tity ;
   'FINSI' ;      
* Valeur du laplacien
   mmg  = GMASS _mt discg 'SCAL' discg 'SCAL' discg 1. ;
   vmtl = GMASS _mt discg 'SCAL' discg 'SCAL' discg 1. c1 c1 ;
   vmt  = 'MAXIMUM' ('RESULT' vmtl) ;
   mmc = GMASS _mt discg 'SCAL' 'CSTE' 'SCAL' 'CSTE' 1. ;
   flap = 'NOMC' 'SCAL' ('*' fsou -1.D0) ;
   vlap  = 'RESOUD' mmg flap ;
   vcont = 'ABS' vlap ;
* Tracé
   'SI' (graph 'ET' debug) ;
      evc = 'EVOL' 'CHPO' vcont 'SCAL' mt ;
      evm = 'EVOL' 'CHPO' cq 'Q' mt ;
      evt = evc 'ET' evm ;
      tabt = 'TABLE' ;
      tabt . 1 = 'CHAINE' 'Controle' ;
      tabt . 2 = 'CHAINE' 'Maillage' ;
      tit = 'CHAINE' 'Parametre de contrôle' ;
      titx = 'CHAINE' 'x' ;
      tity = 'CHAINE' 'Vcont' ;
      dessevol evt tabt tit titx tity ;
   'FINSI' ;      
* Moyenne du contrôle
   nconti = GMASS _mt discg 'SCAL' discg 'SCAL' discg 1. vcont ;
   mcont  = '/' ('MAXIMUM' ('RESULT' nconti)) vmt ;
 
* D'où alpha :
   alpha = '*' ('/' ('-' 1.D0 beta) beta) mcont ;
   'SI' verbose ;
      'MESSAGE' ('CHAINE' '   moy. cont =' mcont) ;
      'MESSAGE' ('CHAINE' '   alpha     =' alpha) ;
   'FINSI' ;      
* D'où le tenseur
   gxxi = GMASS _mt discg 'SCAL' discg 'SCAL' discg 1. vcont vcont ;
   gxx  = 'RESOUD' mmc gxxi ;
   gtot = 'NOMC' 'G11' ('+' 1.D0 ('/' gxx ('*' alpha alpha))) ;
*   Graphique
   'SI' (graph 'ET' debug) ;
      sgtot = '**' gtot 0.5D0 ;
      lgt = 'EXTRAIRE' ('EVOL' 'CHPO' sgtot 'G11' mtc) 'ORDO' ;
      evgt = HISTO lx  lgt ;
      evt   = evgt ;
      tabt  = 'TABLE' ;
      tabt . 1 = 'CHAINE' 'Rac. met.' ;
      tit = 'CHAINE' 'Racine de la métrique (x)'  ;
      titx = 'CHAINE' 'x' ;
      tity = 'CHAINE' 'G' ;
      dessevol evt tabt tit titx tity ;
   'FINSI' ;
'RESPRO' gtot ;
'FINPROC' ;
*
'OPTION' 'DIME' 1 ;
'SI' ('NON' interact) ;
  'OPTION' 'TRAC' 'PS' ;
'SINON' ;
  'OPTION' 'TRAC' 'X' ;
'FINSI' ;
*
* Maillage
*
'OPTI' 'ELEM' 'SEG2' ;
'SI' complet ;
   nmail  = 10 ;
   cvg    = 1.D-4 ; nitmax = 60 ;  
   lelem = 'MOTS' 'SEG2' 'SEG3' ;
   lPe    = 'PROG' 20. 120. 480. ;
   lerref  = 'PROG' 7.E-04  6.E-04  1.5E-02  7.E-04  3.E-04  2.E-04
                    7.E-04  9.E-03  2.5E-02  7.E-04  3.E-03  4.E-03 ;
'SINON' ;
   nmail = 5 ;
   cvg   = 1.D-3 ; nitmax = 60 ;  
   lelem = 'MOTS' 'SEG2' 'SEG3' ;
   lPe   = 'PROG' 10. 60. 200. ;
   lerref = 'PROG' 3.E-03  1.5E-02  1.5E-02  3.E-03  5.E-03  5.E-03
                   3.E-03  2.5E-02  8.E-02   3.E-03  6.E-03  8.E-03 ;
'FINSI' ;
*   Paramètre d'adaptation
*   0.   pas d'adaptation ;
*   0.5  la moitié des mailles dans les régions où le paramètre de
*        contrôle est grand
*   1.   toutes les mailles dans les régions où le paramètre de
*        contrôle est grand
*   Usuellement, 0.5 < beta < 0.8
beta = 0.55D0 ;
* Limitation du déplacement
ldmax = FAUX ;
dmax  = 1. ;
echtem = 1. ;
echdx = 1. ;
* Tests
lok  = VRAI ;
lerr = 'PROG' ;
ind  = 0 ;
*
delem = 'DIME' lelem ;
'REPETER' iielem delem ;
   ielem = &iielem ;
   melem = 'EXTRAIRE' lelem ielem ;
   'OPTI' 'ELEM' melem ;
   tit1 = 'CHAINE' melem ;
   'REPETER' iisupg 2 ;
      isupg = &iisupg ;
      'SI' ('EGA' isupg 1) ;
         lsupg = FAUX ;
         tit2 = 'CHAINE' ' nosupg' ;
      'SINON' ;         
         lsupg = VRAI ;
         tit2 = 'CHAINE' ' supg' ;
      'FINSI' ;
*
      'SI' ('EGA' ('VALEUR' 'ELEM') 'SEG2') ;
         discg = 'LINE' ;
         nmail2 = '*' nmail 2 ;
         csupg = 1.D0 ;
      'SINON' ;
         discg = 'QUAI' ;
         nmail2 = nmail ;
         csupg = 0.5D0 ;
      'FINSI' ;      
      nmf   = 1000 ;
      p0 = 'POIN' 0. ; p1 = 'POIN' 1. ;
      mt = 'DROIT' nmail2 p0 p1 ;
      mtf = 'DROIT' nmf p0 p1 ;
      bor  = p0 'ET' p1 ;
      borb = 'DIFF' ('CHANGER' 'POI1' mt) ('CHANGER' 'POI1' bor) ;
*
      methgau = 'GAU7' ;
      mxpri = 'MOTS' 'UX' ;
      mxdua = 'MOTS' 'FX' ;
      mtpri = 'MOTS' 'T' ;
      mtdua = 'MOTS' 'Q' ;
*
      v1  = 'MANUEL' 'CHPO' mt mxpri ('PROG' 1.D0) ;
      cq  = 'MANUEL' 'CHPO' mt mtdua ('PROG' 0.) ;
      cfx = 'MANUEL' 'CHPO' bor mxdua ('PROG' 0.) ;
      c1  = 'MANUEL' 'CHPO' mt ('MOTS' 'SCAL') ('PROG' 1.) ;
*     
      dPe = 'DIME' lPe ;
      'REPETER' iiPe dPe ;
         Pe = 'EXTRAIRE' lPe &iiPe ;
         iPe = '/' 1.D0 Pe ;
         tit3 = 'CHAINE' ' Pe=' ('ENTIER' Pe) ;
         titg  = 'CHAINE' ' ' tit1 tit2 tit3 ;
         solx = SOLEX iPe mt ;
         tem = '+' ('MANUEL' 'CHPO' mt mtpri ('PROG' 0.D0))
                   ('REDU' solx bor) ;
         solxf = SOLEX iPe mtf ;
         evtxf = 'EVOL' 'VERT' 'CHPO' solxf 'T' mtf ;
*
* Résumé du cas 
*
         'SAUTER' 1 'LIGN' ;
         'MESSAGE' titg ;
         'SAUTER' 1 'LIGN' ;
*
* Algorithme
*
         'REPETER' bcl nitmax ;
            'SI' verbose ;
               'MESSAGE' ('CHAINE' 'Itération : ' &bcl ) ;
            'FINSI' ;               
            _mt   = 'CHANGER' mt 'QUAF' ;
* Pour les histogrammes
            $mt = 'MODE' _mt 'NAVIER_STOKES' 'LINE' ;
            mtc  = 'QUELCONQUE' 'SEG2' ('DOMA' $mt 'CENTRE') ;
            mtl  = 'DOMA' $mt 'MAILLAGE' ;
            xmtl = 'COORDONNEE' 1 mtl ;
            lx = 'EXTRAIRE' ('EVOL' 'CHPO' xmtl mtl) 'ORDO' ;
*
* Calcul du champ de température
*
            dtem fblo = SOLAPP _mt tem ;
            tem = tem '+' dtem ;
            echdtem = 'MAXIMUM' dtem 'ABS' ;
            'SI' verbose ;
               'MESSAGE' ('CHAINE'
                '   Echelle increment thermique : ' echdtem) ;
            'FINSI' ;
            'SI' graph ;
               tit = 'CHAINE' 'Temperature ; i=' &bcl titg ;
               evta = 'EVOL' 'JAUN' 'CHPO' tem 'T' mt ;
               'SI' debug ;
                  'DESSIN' ('ET' evta evtxf) 'TITR' tit ;
               'SINON' ;
                  'SI' verbose ;
                     'DESSIN' ('ET' evta evtxf) 'TITR' tit 'NCLK' ;
                  'FINSI' ;                     
               'FINSI' ;                                 
            'FINSI' ;                  
*
* Calcul du champ de déplacement
*
*  Construction de la métrique   
            tdcd = TGDENT _mt tem beta ;
*   Champ de déplacement
            mblox = 'BLOQUE' 'UX' bor ;
            mblo = mblox ;
            theta = 0.2D0 ;
            gamma = 2.D0 ;
            dep = 'DEDU' 'ADAP' _mt mblo 'DISG' discg
                    'METR' tdcd 'CSTE' 'THET' theta 'GAMM' gamma
                    'NITM' 1 ;
            'SI' faux ;
               'MESSAGE' 'dep' ;
               'LISTE' ('REDU' dep mt)  ;
            'FINSI' ;      
*
            echdep = 'MAXIMUM' dep 'ABS' ;
            'SI' verbose ;
               'MESSAGE' ('CHAINE' '   Echelle des depl. : ' echdep) ;
            'FINSI' ;                  
*
            'SI' ldmax ;
               'SI' ('>' echdep dmax) ;
                  fdep = '/' dmax echdep ;
                  dep = '*' dep fdep ;
               'FINSI' ;
               'SI' verbose ;
                  'MESSAGE' ('CHAINE'
                     '   Echelle des depl. apres lim : ' echdep) ;
               'FINSI' ;                               
            'FINSI' ;
            'FORME' dep ;
            'SI' graph ;
               'SI' debug ;
                  'TRACER' mt 'NOEU' 'TITR' ('CHAINE' 'i=' &bcl) ;
               'SINON' ;
                  'SI' verbose ;               
                     'TRACER' mt 'NOEU' 'TITR' ('CHAINE' 'i=' &bcl)
                           'NCLK' ;
                  'FINSI' ;                           
               'FINSI' ;                           
            'FINSI' ;                        
* Critères de convergence :
* sur les incréments
            crit1 = '<' ('/' echdtem echtem) cvg ;
            crit2 = '<' ('/' echdep echdx) cvg ;
            'SI' ('ET' crit1 crit2) ;
               'QUITTER' bcl ;
            'FINSI' ;      
         'FIN' bcl ;
         'SI' graph ;
             tit = 'CHAINE' 'Temperature ; i=' &bcl titg ;
             evta = 'EVOL' 'JAUN' 'CHPO' tem 'T' mt ;
             'DESSIN' ('ET' evta evtxf) 'TITR' tit  ;
             'TRACER' mt 'NOEU' 'TITR' ('CHAINE' 'i=' &bcl) ;
         'FINSI' ;
*
* Tests d'erreurs
*
         ctem  = 'CHANGER' 'CHAM' tem mt ;
         temf  = proi mtf ctem ;
         evtaf = 'EVOL' 'VERT' 'CHPO' temf 'T' mtf ;
         err = ('INTG' ('-' evtaf evtxf) 'ABSO') ;
         'SI' verbose ;
            'SAUTER' 1 'LIGN' ;
         'FINSI' ;            
         'MESSAGE' ('CHAINE'
                '   Erreur/sol. analytique : ' err) ;
         lerr = 'ET' lerr ('PROG' err) ;
         ind = '+' ind 1 ;
         errref = 'EXTRAIRE' lerref ind ;
         terr = ('<' err errref) ;
         'SI' ('NON' terr) ;
            cherr = 'CHAINE' '!!! Erreur, on aurait voulu err < '
                             errref ;
           'MESSAGE' cherr ;                          
         'FINSI' ;                          
         lok = 'ET' lok terr ;
      'FIN' iiPe ;
   'FIN' iisupg ;
'FIN' iielem ;         
*
* Fin du jeu de donnees 
*
'SAUTER' 2 'LIGNE' ;
'SI' lok ;
   'MESSAGE' 'Tout sest bien passe' ;
'SINON' ;
   'MESSAGE' 'Il y a eu des erreurs' ;
'FINSI' ;   
'SAUTER' 2 'LIGNE' ;
'SI' interact ;
   'OPTION' 'DONN' 5 'ECHO' 1 ;
'FINSI' ;   
'SI' ('NON' lok) ;
   'ERREUR' 5 ;
'FINSI' ;   
*
* End of dgibi file DEDU_CL1D
*
'FIN' ;
 
 
 
 
 
 
 
 
 
 

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