Télécharger dedu_vahl.dgibi

Retour à la liste

* fichier : dedu_vahl.dgibi
************************************************************************
************************************************************************
'OPTI' 'ECHO' 0 ;
************************************************************************
* NOM         : DEDU_VAHL
* DESCRIPTION : Calcul de la cavité carrée différentiellement chauffée
*               (Navier-Stokes incompressible + Energie) pour plusieurs
*               nombres de Rayleigh et comparaison avec les résultats de
*               référence de De Vahl Davis :
*
*@Article{vahl_davis,
*  author =       {G. De Vahl Davis},
*  title =        {Natural Convection of air in a square cavity: a bench
*                  mark numerical solution}, 
*  journal =      {IJNMF},
*  year =         {1983},
*  volume =    {3},
*  pages =     {249-264},
*  endroit = {Classeur Benchmarks (I)}
*}
*
*              On utilise une adaptation de maillage par bougé de noeuds
*              utilisant l'algorithme implémenté dans 'DEDU' 'ADAP'
*              pour calculer le cas avec peu de mailles et sans
*              viscosité artificielle (décentrement).
*              On arrive à passer Ra= 10^6 avec un maillage 15x15
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 30/07/2007, version initiale
* HISTORIQUE : v1, 30/07/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_vahl.dgibi' ;
'SAUTER' 2 'LIGNE' ;
*
*
*
interact= FAUX ;
graph   = FAUX ;
verbose = FAUX ;
debug   = FAUX ;
complet = 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 . 'DAT' . &iidim . 'VALEUR' = vtot ;
*      
      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 ;
      A . 'DAT' . idat . 'VALEUR' = vtot ;
   '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 ;
*      B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomco vtot nomco ;
      B . 'DAT' . idat . 'VALEUR' = vtot ;
   '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 gbbt
************************************************************************
* NOM         : GBBT
* DESCRIPTION : Copie de GDIV mais en précablé
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 14/09/2004, version initiale
* HISTORIQUE : v1, 14/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' GBBT ;
'ARGUMENT'     _mt*'MAILLAGE' ;
'ARGUMENT'   gdisc*'MOT     ' ;
'ARGUMENT'   discv*'MOT     ' ;
'ARGUMENT'   discp*'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' ;      
*
   vdim = 'VALEUR' 'DIME' ;
   vmod = 'VALEUR' 'MODE' ;
   idim = 0 ;
   lpp = 'MOTS' 'LX'      ; ldp = 'MOTS' 'FLX' ;   
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
      lpv = 'MOTS' 'UX' 'UY' ; ldv = 'MOTS' 'FX' 'FY' ;
      idim = 2 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
      lpv = 'MOTS' 'UR' 'UZ' ; ldv = 'MOTS' 'FR' 'FZ' ;
      idim = 2 ;
      iaxi = VRAI ;
   'FINSI' ;
   'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
      lpv = 'MOTS' 'UX' 'UY' 'UZ' ; ldv = 'MOTS' 'FX' 'FY' 'FZ' ;
      idim = 3 ;
      iaxi = FAUX ;
   'FINSI' ;
   'SI' ('EGA' idim 0) ;
      'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
   'FINSI' ;
   'SI' iaxi ;
      dp = ('*' PI 2.D0) ;
      rmt = 'COORDONNEE' 1 _mt ;
   'FINSI' ;      
*   
   numop  = 2 ;
   numder = idim ;
   mmp = 'MOTS' nomp ;
   idim1 = '+' idim 1 ;
   numvar = idim1 ;
   'SI' iaxi ;
      numdat = 3 ;
      numcof = 3 ;
   'SINON' ;      
      numdat = 1 ;
      numcof = 1 ;
   'FINSI' ;      
*
   A = ININLIN numop numvar numdat numcof numder ;   
   'REPETER' iidim idim ;
      A . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' ('EXTRAIRE' lpv &iidim) ;
      A . 'VAR' . &iidim . 'DISC'   = discv ;
   'FIN' iidim ;
   A . 'VAR' . idim1 . 'NOMDDL' = lpp ;
   A . 'VAR' . idim1 . 'DISC'   = discp ;
   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 ;
*
   'SI' iaxi ;
      A . 'DAT' . 2 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      A . 'DAT' . 2 . 'DISC'   = 'CSTE' ;
      A . 'DAT' . 2 . 'VALEUR' = dp ;
      A . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
      A . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
      A . 'DAT' . 3 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      A . 'DAT' . 3 . 'DISC'   = gdisc ;
      A . 'DAT' . 3 . 'VALEUR' = rmt ;
      A . 'COF' . 3 . 'COMPOR' = 'IDEN' ;
      A . 'COF' . 3 . 'LDAT'   = 'LECT' 3 ;
   'FINSI' ;
*
   'SI' iaxi ;
      'REPETER' iidim idim ;
         A . 1 . &iidim . &iidim  = 'LECT' 1 2 3 ;
      'FIN' iidim ;
      A . 1 . 1 . 0 = 'LECT' 1 2 ;
   'SINON' ;
      'REPETER' iidim idim ;
         A . 1 . &iidim . &iidim  = 'LECT' 1 ;
      'FIN' iidim ;
   'FINSI' ;
   A . 2 . idim1 . 0 = 'LECT' ;
*
   'SI' iaxi ;
      numdat = 3 ;
      numcof = 3 ;
   'SINON' ;      
      numdat = 1 ;
      numcof = 1 ;
   'FINSI' ;      
   B = ININLIN numop numvar numdat numcof numder ;   
   'REPETER' iidim idim ;
      B . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' ('EXTRAIRE' ldv &iidim) ;
      B . 'VAR' . &iidim . 'DISC'   = discv ;
   'FIN' iidim ;
   B . 'VAR' . idim1 . 'NOMDDL' = ldp ;
   B . 'VAR' . idim1 . 'DISC'   = discp ;
   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'   = 'CSTE' ;
      B . 'DAT' . 2 . 'VALEUR' = dp ;
      B . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
      B . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
      B . 'DAT' . 3 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      B . 'DAT' . 3 . 'DISC'   = gdisc ;
      B . 'DAT' . 3 . 'VALEUR' = rmt ;
      B . 'COF' . 3 . 'COMPOR' = 'IDEN' ;
      B . 'COF' . 3 . 'LDAT'   = 'LECT' 3 ;
   'FINSI' ;
*
   'SI' iaxi ;
      'REPETER' iidim idim ;
         B . 2 . &iidim . &iidim  = 'LECT' 1 2 3 ;
      'FIN' iidim ;
      B . 2 . 1 . 0 = 'LECT' 1 2 ;
   'SINON' ;
      'REPETER' iidim idim ;
         B . 2 . &iidim . &iidim  = 'LECT' 1 ;
      'FIN' iidim ;
   'FINSI' ;
   B . 1 . idim1 . 0 = 'LECT' ;
*
   mgbbt = 'NLIN' gdisc _mt A B methgau ;
*
'RESPRO' mgbbt ;
'FINPROC' ;
*
* End of procedure file GBBT
*
*ENDPROCEDUR gbbt
*BEGINPROCEDUR ggradt
************************************************************************
* NOM         : GGRADT
* DESCRIPTION : Gradient d'une quantité
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 08/03/2006, version initiale
* HISTORIQUE : v1, 08/03/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' GGRADT ;
'ARGUMENT'     _mt*'MAILLAGE' ;
'ARGUMENT'   gdisc*'MOT     ' ;
'ARGUMENT'    nomp*'MOT     ' ;
'ARGUMENT'   discp*'MOT     ' ;
'ARGUMENT'    nomv*'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 ;
   lpp  = 'MOTS' nomp ;
   ldv  = nomv ;
   'SI' ('ET' ('EGA' vdim 1) ('EGA' vmod 'UNIDPLANDYDZ')) ;
      idim = 1 ;
      iaxi = FAUX ;
   'FINSI' ;
   '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' idim 0) ;
      'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
   'FINSI' ;
   'SI' iaxi ;
      dp = ('*' PI 2.D0) ;
      rmt = 'COORDONNEE' 1 _mt ;
   'FINSI' ;      
*   
   numop  = idim ;
   numder = idim ;
   numvar = 1 ;
   'SI' iaxi ;
      numdat = 3 ;
      numcof = 3 ;
   'SINON' ;      
      numdat = 1 ;
      numcof = 1 ;
   'FINSI' ;      
*
   A = ININLIN numop numvar numdat numcof numder ;   
   A . 'VAR' . 1 . 'NOMDDL' = lpp ;
   A . 'VAR' . 1 . 'DISC'   = discp ;
   'SI' ('EXISTE' chpop) ;
      A . 'VAR' . 1 . 'VALEUR'   = chpop ;
   'FINSI' ;   
   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 ;
   'SI' iaxi ;
      A . 'DAT' . 2 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      A . 'DAT' . 2 . 'DISC'   = 'CSTE' ;
      A . 'DAT' . 2 . 'VALEUR' = dp ;
      A . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
      A . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
      A . 'DAT' . 3 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      A . 'DAT' . 3 . 'DISC'   = gdisc ;
      A . 'DAT' . 3 . 'VALEUR' = rmt ;
      A . 'COF' . 3 . 'COMPOR' = 'IDEN' ;
      A . 'COF' . 3 . 'LDAT'   = 'LECT' 3 ;
   'FINSI' ;
*
   'SI' iaxi ;
      'REPETER' iidim idim ;
         A . &iidim . 1 . 0 = 'LECT' 1 2 3 ;
      'FIN' iidim ;
   'SINON' ;
      'REPETER' iidim idim ;
         A . &iidim . 1 . 0 = 'LECT' 1 ;
      'FIN' iidim ;
   'FINSI' ;         
*
   numvar = idim ;
   numdat = 0 ;
   numcof = 0 ;
   B = ININLIN numop numvar numdat numcof numder ;   
   'REPETER' iidim idim ;
      msinc = 'MOTS' ('EXTRAIRE' ldv &iidim) ;
      B . 'VAR' . &iidim . 'NOMDDL' = msinc  ;
      B . 'VAR' . &iidim . 'DISC'   = discv ;
      'SI' ('EXISTE' chpod) ;
         B . 'VAR' . &iidim . 'VALEUR'   = 'EXCO' msinc chpod msinc ;
      'FINSI' ;   
   'FIN' iidim ;
*   
   'REPETER' iidim idim ;
      B . &iidim . &iidim . &iidim = 'LECT' ;
   'FIN' iidim ;      
*
   mggradt = 'NLIN' gdisc _mt A B methgau ;
*
'RESPRO' mggradt ;
'FINPROC' ;
*
* End of procedure file GGRADT
*
*ENDPROCEDUR ggradt
*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 gmail
************************************************************************
* NOM         : GMAIL
* DESCRIPTION : Extrait le maillage des points supports des degrés
*               de liberté d'une inconnue
*
*               Cette procédure est identique à GMAIL2 qui paraissait
*               mieux que l'ancienne GMAIL
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 20/04/2012, version initiale
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' GMAIL ;
'ARGUMENT'     _mt/'MAILLAGE' ;
'ARGU' tdisc/'TABLE' ;
xmt    = 'EXIS' _mt ;
xtdisc = 'EXIS' tdisc ;
*
'SI' ('NON' xmt) ;
   'SI' ('NON' xtdisc) ;
      'ARGUMENT' tdisc*'TABLE' ;
      xtdisc = vrai ;
   'FINS' ;      
   'ARGUMENT' nmt*'MOT' ;
   'SI' ('NON' ('EXISTE' tdisc nmt)) ;
      cherr = 'CHAINE' 'Le domaine ' nmt ' nest pas defini dans'
      ' la table de discretisation' ;
      'ERREUR' cherr ;
   'FINSI' ;      
   _mt = tdisc . nmt . 'QUAF' ;
'FINSI' ;
*
'ARGU' dua*'MOT' ;
'SI' ('NON' xtdisc) ;
   discdua = dua ;
*   nomdua  = dua ;
'SINO' ;
*   nomdua  = dua ;
   discdua = tdisc . dua . 'DISC' ;
'FINS' ;   
*
*'ARGUMENT'    nomdua*'MOT     ' ;
*
* Raccourcis du 2019/01/25
* Est-ce vraiment astucieux ?...
*
'SI' ('EGA' discdua 'QUAF') ;
   'RESP' _mt ;
   'QUIT' GMAIL ;
'FINS' ;   
'SI' ('EGA' discdua 'LINE') ;
   'RESP' ('CHAN' _mt 'LINE') ;
   'QUIT' GMAIL ;
'FINS' ;   
'SI' ('EGA' discdua 'QUAI') ;
   'RESP' ('CHAN' _mt 'QUAD') ;
   'QUIT' GMAIL ;
'FINS' ;   
*
mdim = DEADUTIL 'DIMM' _mt ;
*vdim = 'VALEUR' 'DIME' ;
'SI' ('EGA' discdua 'LINM') ;
   discdua = 'CSTE' ;
'FINSI' ;
*
numop = 1 ; numder = mdim ; numvar = 1 ; numdat = 0 ; numcof = 0 ;
A = ININLIN numop numvar numdat numcof numder ;
A . 'VAR' . 1 . 'VALEUR' = 0. ;
*
A . 1 . 1 . 0 = 0 ;
*
B = ININLIN numop numvar numdat numcof numder ;   
B . 'VAR' . 1 . 'NOMDDL' = 'DUMM' ;
B . 'VAR' . 1 . 'DISC'   = discdua ;
*
B . 1 . 1 . 0 = 0 ;
*
gm = 'NLIN' 'LINE' _mt A B 'ERF1' 'GAU1' ;
dom = 'EXTRAIRE' gm 'MAIL' ;
*
'RESPRO' dom ;
'FINPROC' ;
*
* End of procedure file GMAIL
*
*ENDPROCEDUR gmail
*
* Procédure donnant les valeurs des Nusselts de référence
*
'DEBPROC' VAHL ;
'ARGUMENT' Ra*'FLOTTANT' ;
lok = FAUX ;
iRa = 'ENTIER' ('+' Ra 0.5D0) ;
'SI' ('EGA' iRa 1000) ;
   lok = VRAI ;
   Nu  = 1.118 ;
'FINSI' ;   
'SI' ('EGA' iRa 10000) ;
   lok = VRAI ;
   Nu  = 2.243 ;
'FINSI' ;   
'SI' ('EGA' iRa 100000) ;
   lok = VRAI ;
   Nu  = 4.519 ;
'FINSI' ;   
'SI' ('EGA' iRa 1000000) ;
   lok = VRAI ;
   Nu  = 8.800 ;
'FINSI' ;   
'SI' ('NON' lok) ;
   cherr = 'CHAINE' 'Pas de sol tabulee pour Ra = ' Ra ;
   'ERREUR' cherr ;
'FINSI' ;
'RESPRO' Nu ;
'FINPROC' ;
*
* Calcul de l'incrément vitesse-pression-temperature
* NS incompressible + Boussinesq
*
'DEBPROC' SOLAPP ;
'ARGUMENT' _mt*'MAILLAGE' ;
'ARGUMENT' inco*'CHPOINT' ;
*
* Vitesse-pression
*
*   
   mlapx = GLAPN _mt discg 'UX' discv 'FX' discv cdifu ;
   mlapx = '*' mlapx -1.D0 ;
   mlapy = 'CHANGER' 'INCO' mlapx ('MOTS' 'UX') ('MOTS' 'UY')
                                  ('MOTS' 'FX') ('MOTS' 'FY') ;
   mcnvx = GUGRAD _mt discg 'UX' discv 'FX' discv inco mxpri discv
                  ccnvu ;
   mcnvy = 'CHANGER' 'INCO' mcnvx ('MOTS' 'UX') ('MOTS' 'UY')
                                  ('MOTS' 'FX') ('MOTS' 'FY') ;
   'SI' lsupg ;
      mdecx = GDECENT 2 _mt discg 'UX' discv 'FX' discv inco mxpri discv 
                     ('*' csupg ccnvu) cdifu 2.D0 ;
      mdecy = 'CHANGER' 'INCO' mdecx ('MOTS' 'UX') ('MOTS' 'UY')
                                     ('MOTS' 'FX') ('MOTS' 'FY') ;
   'FINSI' ;                     
   mbbt  = GBBT _mt discg discv discp -1. ;
* Régularisation de pression
   mp    = GMASS _mt discg 'LX' discp 'FLX' discp ('*' ap -1.D0) ;
* Terme source
*   fbou  = GMASS _mt discg 'T' disct 'FY' discv ('/' Ra Pr) inco ;
   mbou  = GMASS _mt discg 'T' disct 'FY' discv cbouu ;
   mbou  = '*' mbou -1.D0 ; 
   mmasx = GMASS _mt discg 'UX' discv 'FX' discv
                                      ('*' nx 1.D0) ;
   mmasy = 'CHANGER' 'INCO' mlapx ('MOTS' 'UX') ('MOTS' 'UY')
                                  ('MOTS' 'FX') ('MOTS' 'FY') ;
* Blocage vitesse
   mblov  = 'BLOQUE' 'DEPL' bor ;
* Température   
   mlapt = GLAPN _mt discg 'T' disct 'Q' disct cdift ;
   mlapt = '*' mlapt -1.D0 ;
   mcnvt = GUGRAD _mt discg 'T' disct 'Q' disct inco mxpri discv ccnvt ;
   'SI' lsupg ;
      mdect = GDECENT 2 _mt discg 'T' disct 'Q' disct inco mxpri discv 
                     ('*' csupg ccnvt) cdift 2.D0 ;
   'FINSI' ;                     
* Blocage température
   mblotg = 'BLOQUE' 'T' gau ;
   fblotg = 'DEPIMPOSE' mblotg 0.5D0 ;
   mblotd = 'BLOQUE' 'T' dro ;
   fblotd = 'DEPIMPOSE' mblotd -0.5D0 ;
*
   mphy  = mlapx 'ET' mlapy 'ET' mcnvx 'ET' mcnvy 'ET' mbbt 'ET' mbou
              'ET' mblov 'ET' mlapt 'ET' mcnvt 'ET' mblotg 'ET' mblotd ;
   'SI' lsupg ;
      mphy = mphy 'ET' mdecx 'ET' mdecy 'ET' mdect ;
   'FINSI' ;           
   mtot = mphy 'ET' mp 'ET' mmasx 'ET' mmasy ;
*
   ftot = '-' (fblotg '+' fblotd) ('*' mphy inc) ;
*
   incr = 'KRES' mtot ftot ;
   'RESPRO' incr ;
'FINPROC' ;
*
* Calcul du nombre de Nusselt en paroi gauche et droite
*
'DEBPROC' CALCNUSS ;
'ARGUMENT' inco*'CHPOINT' ;
mlapt = GLAPN _mt discg 'T' disct 'Q' disct cdift ;
mlapt = '*' mlapt -1.D0 ;
mcnvt = GUGRAD _mt discg 'T' disct 'Q' disct inco mxpri discv ccnvt ;
'SI' lsupg ;
   mdect = GDECENT 2 _mt discg 'T' disct 'Q' disct inco mxpri discv 
                  ('*' csupg ccnvt) cdift 2.D0 ;
'FINSI' ;
mtot = mlapt 'ET' mcnvt ;
'SI' lsupg ;
   mtot = mtot 'ET' mdect ;
'FINSI' ;   
fres = '*' ('*' mtot inco) -1.D0 ;
'SI' (graph 'ET' debug) ;
   tit = 'CHAINE' 'Valeur du résidu en température'  ;
   'TRACER' fres _mt  'TITR' tit ;
'FINSI' ;
fresgau = 'REDU' fres gau ;
fresdro = 'REDU' fres dro ;
nusgau = 'MAXIMUM' ('RESULT' fresgau) ;
nusdro = 'MAXIMUM' ('RESULT' fresdro) ;
nusgau = '/' nusgau cdift ;
nusdro = '/' nusdro cdift ;
'RESPRO' nusgau nusdro ;
'FINPROC' ;
*
* Calcul de la métrique : on utilise une combinaison de :
* grad v : gradtv et (grad T)^2 pour réaliser l'adaptation 
*
'DEBPROC' TGDENT ;
'ARGUMENT' _mt*'MAILLAGE' ;
'ARGUMENT' vit*'CHPOINT' ;
'ARGUMENT' tem*'CHPOINT' ;
'ARGUMENT' beta*'FLOTTANT' ;
* Volume des éléments
vmtl = GMASS _mt discg 'SCAL' discg 'SCAL' discg 1. c1 c1 ;
vmt  = 'MAXIMUM' ('RESULT' vmtl) ;
discc = 'CSTE' ;
*
* Calcul de la dissipation thermique
*
fdtxi = GLAPN _mt discg 'UX' discv 'UX' discv cdifu vit vit ;
fdtyi = GLAPN _mt discg 'UY' discv 'UY' discv cdifu vit vit ;
fdtxi = '*' fdtxi -1. ; 
fdtyi = '*' fdtyi -1. ; 
fdtx = '/' fdtxi vmtl ;
fdty = '/' fdtyi vmtl ;
fdt = '+' fdtx fdty ;
'SI' lsupgm ;
   fdecxi = GDECENT 2 _mt discg 'UX' discv 'UX' discv vit mxpri discv 
                     ('*' csupg ccnvu) cdifu 2.D0 vit vit ;
   fdecyi = GDECENT 2 _mt discg 'UY' discv 'UY' discv vit mxpri discv 
                     ('*' csupg ccnvu) cdifu 2.D0 vit vit ;
   fdecx = '/' fdecxi vmtl ;
   fdecy = '/' fdecyi vmtl ;
   fdec = '+' fdecx fdecy ;
'FINSI' ;                     
'SI' (graph 'ET' debug) ;
   rescal = 'KCHA' $mt fdt 'CHAM' ;
   tit = 'CHAINE' 'Dissipation thermique'  ;
   'TRACER' rescal $mb 'TITR' tit ;
   'SI' lsupg ;
      rescal = 'KCHA' $mt fdec 'CHAM' ;
      tit = 'CHAINE' 'Dissipation numérique'  ;
      'TRACER' rescal $mb 'TITR' tit ;
   'FINSI' ;
'FINSI' ;
'SI' lsupg ;
   fdt = '+' fdt fdec ;
'FINSI' ;
*
* Calcul du gradient de T au carré
*
fdqi = GLAPN _mt discg 'T' disct 'T' disct cdift tem tem ;
fdqi = '*' fdqi -1. ; 
fdq = '/' fdqi vmtl ;
*
'SI' (graph 'ET' debug) ;
   rescal = 'KCHA' $mt fdq 'CHAM' ;
   tit = 'CHAINE' 'Abs. grad T au carré'  ;
   'TRACER' rescal $mb 'TITR' tit ;
'FINSI' ;
*
* Scaling des dissipations 
*
sfdti = GMASS _mt discg 'SCAL' 'CSTE' 'SCAL' 'CSTE' 1. fdt ;
mfdt = '/' ('MAXIMUM' ('RESULT' sfdti)) vmt ;
'SI' verbose ;
   'MESSAGE' ('CHAINE' '   Diss. therm. moy. =' mfdt) ;
'FINSI' ;   
sfdqi = GMASS _mt discg 'SCAL' 'CSTE' 'SCAL' 'CSTE' 1. fdq ;
mfdq = '/' ('MAXIMUM' ('RESULT' sfdqi)) vmt ;
'SI' verbose ;
   'MESSAGE' ('CHAINE' '   |gradT^2|  moy. =' mfdq) ;
'FINSI' ;   
* D'où alpha :
alphat = '*' ('/' ('-' 1.D0 beta) beta) mfdt ;
alphaq = '*' ('/' ('-' 1.D0 beta) beta) mfdq ;
'SI' ('ET' debug verbose) ;
   'MESSAGE' ('CHAINE' '   Alphat = ' alphat) ;
   'MESSAGE' ('CHAINE' '   Alphaq = ' alphaq) ;
'FINSI' ;
fdt = '/' fdt alphat ;
fdq = '/' fdq alphaq ;
'SI' (graph 'ET' debug) ;
   rescal = 'KCHA' $mt fdt 'CHAM' ;
   tit = 'CHAINE' 'fdt scalé'  ;
   'TRACER' rescal $mb 'TITR' tit ;
   rescal = 'KCHA' $mt fdq 'CHAM' ;
   tit = 'CHAINE' 'fdq scalé'  ;
   'TRACER' rescal $mb 'TITR' tit ;
'FINSI' ;
fdt = '+' fdt fdq ;
'SI' (graph 'ET' debug) ;
   rescal = 'KCHA' $mt fdt 'CHAM' ;
   tit = 'CHAINE' 'fdtotal'  ;
   'TRACER' rescal $mb 'TITR' tit ;
'FINSI' ;   
*
* Calcul du gradient de la dissipation thermique et du tenseur directionnel
*
lmvit  = 'MOTS' 'UX' 'UY' ;
mmgs   = GMASS _mt discg lmvit discr lmvit discr 1. ;
gfdti  = GGRADT _mt discg 'SCAL' 'CSTE' lmvit discr 1. fdt ;
*gfdt  = '/' gfdti vmtl ;
gfdts  = 'RESOUD' mmgs gfdti ;
gfdti  = GMASS _mt discg lmvit discr lmvit 'CSTE' 1. gfdts ;
gfdt   = '/' gfdti vmtl ;
'SI' (graph 'ET' debug) ;
   tit = 'CHAINE' 'Gradient de dissipation thermique ; i=' &bcl ;
   vvit = 'VECT' gfdt 'DEPL' 'JAUN' ;
   'TRACER' vvit mt 'TITR' tit ;
'FINSI' ;        
*
* Lissage du gradient
*
'SI' lissg ;
   mms  = GMASS _mt discg  'SCAL' discg  'SCAL' discr 1. c1 ;
   gfdti = GMASS _mt discg lmvit 'CSTE' lmvit discr 1. gfdt ;
   gfdts = '/' gfdti mms ;
   gfdtsi = GMASS _mt discg lmvit discr lmvit 'CSTE' 1. gfdts ;
   gfdt   = '/' gfdtsi vmtl ;
   'SI' (graph 'ET' debug) ;
      tit = 'CHAINE' 'Gradient apres lissage ; i=' &bcl ;
      vvit = 'VECT' gfdt 'DEPL' 'JAUN' ;
      'TRACER' vvit mt 'TITR' tit ;
   'FINSI' ;
'FINSI' ;
*
nfdt   = 'PSCAL' gfdt gfdt lmvit lmvit ;
snfdt  = '**' nfdt 0.5D0 ;
msnfdt  = 'MAXIMUM' snfdt ;
'SI' ('<' msnfdt 1.D-100) ;
   binf = 1.D0 ;
'SINON' ;
   binf = '*' msnfdt 1.D-10 ;
'FINSI' ;   
snfdt   = '+' snfdt binf ;
sgfdt  = '/' gfdt snfdt ;
'SI' (graph 'ET' debug) ;
   tit = 'CHAINE' 'Gddt mis a lechelle ; i=' &bcl ;
   vvit = 'VECT' sgfdt 'DEPL' 'JAUN' ;
   'TRACER' vvit mt 'TITR' tit ;
'FINSI' ;
td11 = '*' sgfdt sgfdt ('MOTS' 'UX') ('MOTS' 'UX') ('MOTS' 'SCAL') ;
td22 = '*' sgfdt sgfdt ('MOTS' 'UY') ('MOTS' 'UY') ('MOTS' 'SCAL') ;
td12 = '*' sgfdt sgfdt ('MOTS' 'UX') ('MOTS' 'UY') ('MOTS' 'SCAL') ;
* D'où le tenseur
gxx  = '**' fdt 2 ;
vdim = 'VALEUR' 'DIME' ;
limgd2 = '**' limgd 2 ;
gd1 = '**' gxx ('/' 1.D0 vdim) ;
gd2 = '-' ('**' ('+' gd1 1.) vdim) 1. ;
*
* Considération pour les calculs de ngd :
* en 1D : gd1 = gd2, la partie anisotrope doit s'annuler
*
gdb = '-' ('*' ('**' ('+' gd1 1.) delta)
               ('**' ('+' gd2 1.) ('-' 1. delta))) 1. ;
gda = '-' ('**' ('+' gd1 1.) delta) 1. ;
dgd = '-' gdb gda ;
*
'SI' (graph 'ET' debug) ;
   rescal = 'KCHA' $mt ('**' gda 0.5D0) 'CHAM' ;
   tit = 'CHAINE' 'Partie isotrope de ladaptation'  ;
   'TRACER' rescal $mb 'TITR' tit ;
   rescal = 'KCHA' $mt ('**' dgd 0.5D0) 'CHAM' ;
   tit = 'CHAINE' 'Partie anisotrope de ladaptation'  ;
   'TRACER' rescal $mb 'TITR' tit ;
'FINSI' ;
*
* Limitation des valeurs supérieures
*
*  de la partie isotrope 
   m1    = 'MASQUE' gda 'INFERIEUR' limgd2 ;
   m0    = '*' ('-' m1 1.) -1. ;
   gda   = '+' ('*' m1 gda) ('*' m0 limgd2) ;
* de la partie anisotrope   
   gdb  = gda '+' dgd ;
   m1   = 'MASQUE' gdb 'INFERIEUR' limgd2 ;
   m0   = '*' ('-' m1 1.) -1. ;
   gdb  = '+' ('*' m1 gdb) ('*' m0 limgd2) ;
   dgd = '-' gdb gda ;
'SI' (graph 'ET' debug) ;
   rescal = 'KCHA' $mt ('**' gda 0.5D0) 'CHAM' ;
   tit = 'CHAINE' 'Partie isotrope de ladaptation apres lim'  ;
   'TRACER' rescal $mb 'TITR' tit ;
   rescal = 'KCHA' $mt ('**' dgd 0.5D0) 'CHAM' ;
   tit = 'CHAINE' 'Partie anisotrope de ladaptation apres lim'  ;
   'TRACER' rescal $mb 'TITR' tit ;
'FINSI' ;
*
* Le tenseur
*
   g11 = 'NOMC' 'G11' (gda '+' ('*' dgd td11) '+' 1.D0) ;
   g22 = 'NOMC' 'G22' (gda '+' ('*' dgd td22) '+' 1.D0) ;
   g21 = 'NOMC' 'G21' ('*' dgd td12) ;
   gtot = g11 '+' g22 '+' g21 ;
*   
'RESPRO' gtot fdt ;
'FINPROC' ;
*
* Début du jeu de donnés
*
'OPTION' 'DIME' 2 ;
'SI' ('NON' interact) ;
  'OPTION' 'TRAC' 'PSC' ;
'SINON' ;
  'OPTION' 'TRAC' 'X' ;
'FINSI' ;
*
* Maillage
*
*   Paramètres d'adaptation :
*   beta :
*   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
*   lissd  : lissage de la dissipation thermique
*   limfdt : limitation de la dissipation thermique
*            on limite les valeurs qui dépassent (moy. fdt) * limfdt
*   limgd  : limitation de la diagonale du tenseur métrique
*            on limite les valeurs qui dépassent limgd
*   delta  : 0.D0 adaptation totalement anisotrope
*            1.D0 adaptation totalement isotrope
*   omi : relaxation de l'incrément vitesse-pression-temperature
*   omd : relaxation de l'incrément de déplacement du maillage
*   theta et gamma : paramètres de l'adapteur de DEDU ADAP
om   = 0.9D0 ;
omi  = om ;
omd  = om ;
   'OPTI' 'ELEM' 'QUA8' ;
   'SI' complet ;
      nx = 15 ; ny = 15 ;
      cvg = 2.D-3 ; nitmax = 85 ;
      lRa = 'PROG' 1.D3 1.D4 1.D5 1.D6  ;
      Pr = 0.71 ;
* Ici, sans adaptation , ca marche mieux aux Rayleigh faible
* Mais pour les deux Rayleigh les plus forts, il faut adapter...
*      lerrnu = 'PROG' 2.D-3 4.D-3 3.D-3 2.D-4 ;
* Les erreurs de référence augmentent suite correction bug fiche 10552
      lerrnu = 'PROG' 2.D-3 4.D-3 3.D-3 2.D-3 ;
      adap = VRAI ;
      beta = 0.7D0 ; lissd = FAUX ; limfdt = 7.D0 ;
      theta = 0.5D0 ; gamma = 2.D0 ;
      lissg = FAUX  ; limgd = 15.D0 ;
      delta = 1.D0 ;
   'SINON' ;      
      nx = 10 ; ny = 10 ;
      cvg = 5.D-3 ; nitmax = 50 ;
      lRa = 'PROG' 1.D3 1.D4 1.D5 ;
      Pr = 0.71 ;
* Ici, ca marche aussi bien sans adaptation :)
* Les critères pour adapter ne sont sans doute pas les meilleurs...
      lerrnu = 'PROG' 4.D-3 6.D-3 6.D-3 ;
      adap = VRAI ;
      beta = 0.7D0 ;
      theta = 0.5D0 ; gamma = 2.D0 ;
      lissg = FAUX ; limgd = 15.D0 ;
*      delta = 0.75D0 ;
      delta = 1.D0 ;
   'FINSI' ;
   lerrnuc = 'PROG' ;
   pA = 0. 0. ; pB = 1. 0. ; pC = 1. 1. ; pD = 0. 1. ;
   bas = 'DROIT' nx pA pB ; dro = 'DROIT' ny pB pC ;
   hau = 'DROIT' nx pC pD ; gau = 'DROIT' ny pD pA ;
   mt = 'DALLER' bas dro hau gau ;
   bor = 'CONTOUR' mt ;
_mt = 'CHANGER' mt 'QUAF' ;
$mt = 'MODE' _mt  'NAVIER_STOKES' 'QUAF' ;
$mb  = 'MODE' ('DOMA' $mt 'MAILLAGE') 'THERMIQUE' ;
mtl = 'CHANGER' mt 'LINEAIRE' ;
* Paramètres pour le décentrement 
* lsupg : VRAI=decentrement
* csupg : facteur multiplicatif
lsupg  = FAUX ;
lsupgm = FAUX ;
*csupg = 0.3D0 ;
csupg = 0.7D0 ;
* 
* discg : discrétisation géométrique
* discv : discrétisation vitesse
* discp : discrétisation pression
* disct : discrétisation température
* discr : discrétisation pour la mise au sommet du paramètre de contrôle
discg = 'QUAF' ;
discv = 'QUAF' ;
discp = 'LINE' ;
disct = 'QUAF' ;
discr = 'LINE' ;
*
methgau = 'GAU7' ;
mxpri = 'MOTS' 'UX' 'UY' ;
mxdua = 'MOTS' 'FX' 'FY' ;
mppri = 'MOTS' 'LX' ;
mpdua = 'MOTS' 'FLX' ;
mtpri = 'MOTS' 'T' ;
mtdua = 'MOTS' 'Q' ;
* Limitation du déplacement
ldmax = FAUX ;
dmax  = 1. ;
echvit = 1. ;
echtem = 1. ;
echdx = 1. ;
*
*bug detecte fiche 10552 c1  = 'MANUEL' 'CHPO' mt ('MOTS' 'SCAL') ('PROG' 1.) ;
c1  = 'MANUEL' 'CHPO' _mt ('MOTS' 'SCAL') ('PROG' 1.) ;
*
lok = VRAI ;
mailv = GMAIL _mt discv ;
inc = 'MANU' 'CHPO' mailv mxpri ('PROG' 0. 0.) ;
inc = inc '+' ('MANUEL' 'CHPO' gau 1 'T' 0.5)
          '+' ('MANUEL' 'CHPO' dro 1 'T' -0.5) ;
*
dRa = 'DIME' lRa ;
'REPETER' iiRa dRa ;
   Ra = 'EXTRAIRE' lRa &iiRa ;
* Physique
   ccnvu = 1.D0 ;
   cdifu = '**' ('/' Ra Pr) -0.5D0 ;
   cbouu = 1.D0 ;
   ccnvt = 1.D0 ;
   cdift= '**' ('*' Ra Pr) -0.5D0 ;
* Numérique
   ap= 1.D-4 ;
*
* Résumé du cas 
*
   'SAUTER' 1 'LIGN' ;
   'MESSAGE' ('CHAINE' '***********************************') ;
   'MESSAGE' ('CHAINE' 'Résumé du cas :                    ') ;
   'MESSAGE' ('CHAINE' 'Nombre de maille  = ' nx ' x ' ny) ;
   'MESSAGE' ('CHAINE' 'Rayleigh          = ' Ra) ;
   'MESSAGE' ('CHAINE' 'Param. adaptation = ' beta) ;
   'MESSAGE' ('CHAINE' '***********************************') ;
*
* Algorithme
*
   'REPETER' bcl nitmax ;
      'SI' verbose ;
         'MESSAGE' ('CHAINE' 'Itération : ' &bcl ) ;
      'FINSI' ;
* Calcul des champs
      dinc = SOLAPP _mt inc ;
      inc  = inc '+' ('*' dinc omi) ;
      vit = 'EXCO' mxpri inc ;
      pre = 'EXCO' mppri inc ;
      tem = 'EXCO' mtpri inc ;
      dvit = 'EXCO' mxpri dinc ;
      dtem = 'EXCO' mtpri dinc ;
*bug fiche 10552 : le calcul du Nusselt dépend aussi de la vitesse.      
*      nusgau nusdro = calcnuss tem ;
      nusgau nusdro = calcnuss inc ;
      'SI' verbose ;
         'MESSAGE' ('CHAINE' '   Nusselt gauche : ' nusgau) ;
         'MESSAGE' ('CHAINE' '   Nusselt droite : ' nusdro) ;
      'FINSI' ;         
      echvit = '/' ('MAXIMUM' vit 'ABS') ('*' omi 2.0D0) ;
      'SI' verbose ;
        'MESSAGE' ('CHAINE' '   Echelle vitesse : ' echvit) ;
      'FINSI' ;           
      echdvit = '/' ('MAXIMUM' dvit 'ABS') echvit ;
      echdtem = '/' ('MAXIMUM' dtem 'ABS') echtem ;
      'SI' verbose ;
        'MESSAGE' ('CHAINE' '   Echelle increment vitesse : ' echdvit) ;
        'MESSAGE' ('CHAINE' '   Echelle increment tempera : ' echdtem) ;
      'FINSI' ;
*   
      'SI' graph  ;
         'SI' debug ;
            tit = 'CHAINE' 'Vitesse ; i=' &bcl ;
            vvit = 'VECT' ('/' 0.8 ('*' echvit nx)) vit 'DEPL' 'JAUN' ;
            'TRACER' vvit _mt 'TITR' tit ;
            tit = 'CHAINE' 'Pression ; i=' &bcl ;
            'TRACER' pre mtl 'TITR' tit ;
            tit = 'CHAINE' 'Temperature ; i=' &bcl ;
            'TRACER' tem _mt 'TITR' tit ;
         'FINSI' ;            
      'FINSI' ;
*
* Calcul du champ de déplacement
*
*    Construction de la métrique
      'SI' adap ;
         tdcd fdt = TGDENT _mt vit tem beta ;
      'FINSI' ;
      'SI' graph ;
         rescal = tem ;
         vvit = 'VECT' ('/' 0.8D0 ('*' echvit nx)) vit
                       'DEPL' 'JAUN' ;
         tit = 'CHAINE' 'Temp. + Vitesse ; i=' &bcl ' ; Ra='
                Ra ;
         'SI' debug ;
            'TRACER' rescal vvit _mt 'TITR' tit ;
         'SINON' ;            
            'TRACER' rescal vvit _mt 'TITR' tit 'NCLK' ;
         'FINSI' ;            
      'FINSI' ;
      'SI' adap ;         
*   Champ de déplacement
         mblox = 'BLOQUE' 'UX' (gau 'ET' dro) ;
         mbloy = 'BLOQUE' 'UY' (bas 'ET' hau) ;
         mblo = mblox 'ET' mbloy ;
         dep = 'DEDU' 'ADAP' _mt mblo 'DISG' discg
                            'METR' tdcd 'CSTE' 'THET' theta 'GAMM' gamma
                            'NITM' 1  'METG' methgau ;
*   
         echdep = '/' ('MAXIMUM' dep 'ABS') echdx ;
         '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' ;
         dep = '*' dep omd ;
         crit2 = '<' echdep cvg ;
         'SI' ('NON' crit2) ;
            'FORME' dep ;
         'FINSI' ;         
         ciso = DEADUTIL 'QISO' _mt discg 'GAU7' tdcd 'CSTE' ;
         cequ = DEADUTIL 'QEQU' _mt discg 'GAU7' tdcd 'CSTE' ;
         maciso = 'MAXIMUM' ciso ; miciso = 'MINIMUM' ciso ;
         macequ = 'MAXIMUM' cequ ; micequ = 'MINIMUM' cequ ;
         'SI' verbose ;
            'MESSAGE' ('CHAINE'
               '   CISO : max. = ' maciso '  min. = ' miciso) ;
            'MESSAGE' ('CHAINE'
               '   CEQU : max. = ' macequ '  min. = ' micequ) ;
         'FINSI' ;
         'SI' (graph 'ET' debug) ;
            cliso = 'KCHA' $mt ciso 'CHAM' ;
            tit = 'CHAINE' 'Isotropie ; i=' &bcl ' ; Re=' Re ;
            'TRACER' cliso $mb 'TITR' tit ;
            clequ = 'KCHA' $mt cequ 'CHAM' ;
            tit = 'CHAINE' 'Equidis. ; i=' &bcl ' ; Re=' Re ;
            'TRACER' clequ $mb 'TITR' tit ;
         'FINSI' ;
      'FINSI' ;         
* Critères de convergence :
* sur les incréments
      crit1 = '<' echdvit cvg ;
      crit2 = '<' echdtem cvg ;
      critt = crit1 'ET' crit2 ;
      'SI' adap ;
         crit3 = '<' echdep  cvg ;
         critt = critt 'ET' crit3 ;
      'FINSI' ;         
      'SI' critt ;
         'QUITTER' bcl ;
      'FINSI' ;      
   'FIN' bcl ;
   'SI' ('ET' graph interact) ;
      tit = 'CHAINE' 'Vitesse+Tem ; Ra=' Ra ;
      vvit = 'VECT' ('/' 0.8D0 ('*' echvit nx)) vit 'DEPL' 'JAUN' ;
      'TRACER' tem _mt vvit 'TITR' tit ;
   'FINSI' ;
*
* Test sur le Nusselt
*
   nusref = VAHL Ra ;
*bug fiche 10552 : le calcul du Nusselt dépend aussi de la vitesse.      
*   nusgau nusdro = calcnuss tem ;
   nusgau nusdro = calcnuss inc ;
   'MESSAGE' ('CHAINE' '   Nusselt de réference : ' nusref) ;
   'MESSAGE' ('CHAINE' '   Nusselt gauche       : ' nusgau) ;
   'MESSAGE' ('CHAINE' '   Nusselt droite       : ' nusdro) ;
   tsymnu = 'EGA' ('ABS' nusgau) ('ABS' nusdro) 1.D-4 ;
   'SI' ('NON' tsymnu) ;
      cherr = 'CHAINE'
      '!!! Erreur, on aurait voulu |nusgau| = |nusdro|' ;
      'ERREUR' cherr ;
   'FINSI' ;
   lok = 'ET' lok tsymnu ;
   errnu = '/' ('ABS' ('-' ('ABS' nusgau) nusref)) ('ABS' nusref) ;
   'MESSAGE' ('CHAINE' '   errnu = ' errnu) ;
   lerrnuc = 'ET' lerrnuc ('PROG' errnu) ;
   vernur  = 'EXTRAIRE' lerrnu &iiRa ;
   ternu   = ('<' errnu vernur) ;
   'SI' ('NON' ternu) ;
      cherr = 'CHAINE' '!!! Erreur, on aurait voulu errnu < ' vernur ;
     'MESSAGE' cherr ;                          
   'FINSI' ;                          
   lok = 'ET' lok ternu ;
'FIN' iiRa ;   
*
* 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_VAHL
*
'FIN' ;