Télécharger kres_cd2.dgibi

Retour à la liste

* fichier :  kres_cd2.dgibi
'OPTION' 'ECHO' 0 ;
*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    : v1, 08/02/2006, version initiale
* HISTORIQUE : v1, 08/02/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' 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' ;      
*
   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' ;
* 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 ;
      'ERREUR' ('CHAINE' 'Axi non implémenté') ;
   'FINSI' ;      
*      
   numop  = idim ;
   numvar = 1 ;
   numdat = 1 ;
   numcof = 1 ;
   numder = idim ;
   mmt = 'MOTS' nomt ;
   mmq = 'MOTS' nomq ;
   ms  = 'MOTS' 'SCAL' ;
*
   A = ININLIN numop numvar numdat numcof numder ;   
   A . 'VAR' . 1 . 'NOMDDL' = mmt ;
   A . 'VAR' . 1 . 'DISC'   = disct ;
   A . 'DAT' . 1 . 'NOMDDL' = ms ;
   A . 'DAT' . 1 . 'DISC'   = discc ;
   A . 'DAT' . 1 . 'VALEUR' = coef ;
   A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
   A . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
*
   'REPETER' iidim idim ;
      A . &iidim . 1 . &iidim = 'LECT' 1 ;
   'FIN' iidim ;      
*
   numvar = 1 ;
   numdat = 0 ;
   numcof = 0 ;
*
   B = ININLIN numop numvar numdat numcof numder ;   
   B . 'VAR' . 1 . 'NOMDDL' = mmq ;
   B . 'VAR' . 1 . 'DISC'   = discq ;
*
   'REPETER' iidim idim ;
      B . &iidim . 1 . &iidim = 'LECT' ;
   '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 ;
      'ERREUR' ('CHAINE' 'Axi non implémenté') ;
   '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 . '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 ;
   numdat = 1 ;
   numcof = 1 ;
*
   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 ;
*
   B . 1 . 1 . 0  = 'LECT' 1 ;
*
   mgugrad = 'NLIN' gdisc _mt A B methgau ;
*
'RESPRO' mgugrad ;
'FINPROC' ;
*
* End of procedure file GUGRAD
*
*ENDPROCEDUR gugrad
*BEGINPROCEDUR formar
************************************************************************
* NOM         : FORMAR
* DESCRIPTION : formate un réel de facon courte
*               pratique pour les noms de
*               sauvegarde
*               Exemples :
* 'MESSAGE' ('CHAINE' (formar 2.9e5   1)) ;
* 2.9E5
* 'MESSAGE' ('CHAINE' (formar -2.9e5  1)) ;
* -2.9E5
* 'MESSAGE' ('CHAINE' (formar 2.9e-5  1)) ;
* 2.9E-5
* 'MESSAGE' ('CHAINE' (formar -2.9e-5 1)) ;
* -2.9E-5
* 'MESSAGE' ('CHAINE' (formar 2.9     1)) ;
* 2.9
* 'MESSAGE' ('CHAINE' (formar -2.9    1)) ;
* -2.9
* 'MESSAGE' ('CHAINE' (formar 0       1)) ;
* 0
* 'MESSAGE' ('CHAINE' (formar 0       1)) ;
* 0
* 'MESSAGE' ('CHAINE' (formar 2.9e5   0)) ;
* 3E5
* 'MESSAGE' ('CHAINE' (formar -2.9e5  0)) ;
* -3E5
* 'MESSAGE' ('CHAINE' (formar 2.9e-5  0)) ;
* 3E-5
* 'MESSAGE' ('CHAINE' (formar -2.9e-5 0)) ;
* -3E-5
* 'MESSAGE' ('CHAINE' (formar 2.9     0)) ;
* 3
* 'MESSAGE' ('CHAINE' (formar -2.9    0)) ;
* -3
* 'MESSAGE' ('CHAINE' (formar 0       0)) ;
* 0
* 'MESSAGE' ('CHAINE' (formar 0       0)) ;
* 0
*               
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 18/02/2003, version initiale
* HISTORIQUE : v1, 18/02/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' FORMAR ;
'ARGUMENT' fl*'FLOTTANT' ;
'ARGUMENT' vir/'ENTIER  ' ;
'SI' ('NON' ('EXISTE' vir)) ;
   vir = 1 ;
'SINON' ;   
   'SI' ('<' vir 0) ;
      'ERREUR' 'fournir un entier positif' ;
   'FINSI' ;
'FINSI' ;         
'SI' ('<' ('ABS' fl) 10.D-100) ;
   chfl = 'CHAINE' '0' ;
'SINON' ;
*! sans le 1.D-10, ca ne fonctionne pas
*! qd on entre pile poil une puissance de 10
   lfl = LOG10 ('ABS' fl) ;
*   lfl = '+' (LOG10 ('ABS' fl)) 1.D-10  ;
   slfl = 'SIGNE' ('ENTIER' lfl) ;
   'SI' ('EGA' slfl 1) ;
      elfl = 'ENTIER' lfl ;
   'SINON' ;
      elfl = '-' ('ENTIER' lfl) 1 ;
   'FINSI' ;
   man = '/' fl ('**' 10.D0 elfl) ;
*
* Une verrue pour des histoires de précision...
*   
   'SI' ('EGA' man 10.D0 ('**' 10.D0 ('*' vir -1.D0))) ;
      man  = '/' man 10.D0 ;
      elfl = '+' elfl 1 ;
   'FINSI' ;
*   
   sman = 'SIGNE' man ;
   'SI' ('EGA' sman 1) ;   
      fman = 'CHAINE' '(F' ('+' vir 2) '.0' vir ')' ;
   'SINON' ;
      fman = 'CHAINE' '(F' ('+' vir 3) '.0' vir ')' ;
   'FINSI' ;
   'SI' ('NEG' vir 0) ;   
      'SI' ('NEG' elfl 0) ;
         chfl = 'CHAINE' 'FORMAT' fman man 'E' elfl ;
      'SINON' ;
         chfl = 'CHAINE' 'FORMAT' fman man ;
      'FINSI' ;
   'SINON' ;
      man2 = 'ENTIER' ('+' man ('*' 0.5D0 sman)) ;
      'SI' ('NEG' elfl 0) ;
         chfl = 'CHAINE' man2 'E' elfl ;
      'SINON' ;
         chfl = 'CHAINE' man2 ;
      'FINSI' ;
   'FINSI' ;            
'FINSI' ;   
'RESPRO' chfl ;
*
* End of procedure file FORMAR
*
'FINPROC' ;
*ENDPROCEDUR formar
*BEGINPROCEDUR log10
************************************************************************
* NOM         : LOG10
* DESCRIPTION : Log_10
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 18/02/2003, version initiale
* HISTORIQUE : v1, 18/02/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' LOG10 ;
'ARGUMENT' fl/'FLOTTANT' ;
'ARGUMENT' lr/'LISTREEL' ;
'ARGUMENT' cp/'CHPOINT ' ;
'ARGUMENT' cm/'MCHAML  ' ;
'SI' ('EXISTE' fl) ;
   'RESPRO' ('/' ('LOG' fl) ('LOG' 10.D0)) ;
'FINSI' ;
'SI' ('EXISTE' lr) ;
   'RESPRO' ('/' ('LOG' lr) ('LOG' 10.D0)) ;
'FINSI' ;
'SI' ('EXISTE' cp) ;
   'RESPRO' ('/' ('LOG' cp) ('LOG' 10.D0)) ;
'FINSI' ;
'SI' ('EXISTE' cm) ;
   'RESPRO' ('/' ('LOG' cm) ('LOG' 10.D0)) ;
'FINSI' ;
*
* End of procedure file LOG10
*
'FINPROC' ;
*ENDPROCEDUR log10
*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 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/'LOGIQUE' ;
*
'SI' ('NON' ('EXISTE' nb)) ;
   nb = FAUX ;
'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' nb ;
   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 ;
      tev . ii = 'CHAINE' 'MARQ ' mi ' ' ti ;
   'SINON' ;      
      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 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) ;
      tab . itab = 'ET' (tab . itab) obj ;
   '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
'DEBPROC' discr ;
'ARGUMENT' Pem*'FLOTTANT' ;
Pe  = Pem '*' nm ;
*
* Solution
*
xm ym = 'COORDONNEE' mt ;
num   = '-' ('EXP' ('*' xm Pe)) 1.D0 ;
denom = '-' ('EXP' Pe) 1.D0 ;
sol = 'NOMC' 'T' ('/' num denom) ;
csol = 'REDU' sol (d2 'ET' d4) ;
'SI' graph ;
   tit = 'CHAINE' 'Sol exacte Pem=' (formar Pem) ;
   'TRACER' sol mt 'TITRE' tit ;
'FINSI' ;      
*
* Matrice
*
disc = 'QUAI' ;
nomt = 'T' ;
nomq = 'Q' ;
mat1 = '*' (GLAPN _mt 'LINE' nomt disc nomq disc 1.) ('/' -1. Pe) ;
nomu = 'MOTS' 'UX' 'UY' ;
valu = 'MANUEL' 'CHPO' mt nomu ('PROG' 1. 0.) ;
mat2 = GUGRAD _mt 'LINE' nomt disc nomq disc valu nomu disc 1.
 ;
matl = mat1 'ET' mat2 ;
matc = 'BLOQUE' 'T' ('ET' d2 d4) ;
fc   = 'DEPIMPOSE' matc csol ;
mtot = matl 'ET' matc ;
ftot = fc ;
'RESPRO' mtot ftot sol ;
'FINPROC' ;
*
************************************************************************
* NOM         : KRES_CD2
* DESCRIPTION : Test de KRES sur une équation de convection-diffusion
*               avec BLOQ
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 08/02/2006, version initiale
* HISTORIQUE : v1, 08/02/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 !
************************************************************************
*
*
complet = FAUX ;
interact= FAUX ;
graph = FAUX ;
'OPTION' 'DIME' 2 'ELEM' 'TRI6'  ;
'SI' ('NON' interact) ;
  'OPTION' 'TRAC' 'PS' ;
'SINON' ;
  'OPTION' 'TRAC' 'X' ;
'FINSI' ;  
*
* Maillage
*
'SI' complet ;
   nm = 100 ;
'SINON' ;   
   nm = 20 ;
'FINSI' ;   
p1 = 0. 0. ; p2 = 1. 0. ; p3 = 1. 1. ; p4 = 0. 1. ;
d1 = 'DROIT' nm p1 p2 ; d2 = 'DROIT' nm p2 p3 ;
d3 = 'DROIT' nm p3 p4 ; d4 = 'DROIT' nm p4 p1 ;
cmt = d1 'ET' d2 'ET' d3 'ET' d4 ;
*mt = 'DALLER' d1 d2 d3 d4 ;cmt = 'CONTOUR' mt ;
mt = 'SURFACE' cmt ;
_mt = 'CHANGER' 'QUAF' mt ;
 
tabmit = 'TABLE' ;
tabmit . 1 = 'CHAINE' 'CG' ;
tabmit . 2 = 'CHAINE' 'BiCGStab' ;
tabmit . 3 = 'CHAINE' 'BiCGStab(4)' ;
tabmit . 4 = 'CHAINE' 'GMRES(50)' ;
tabmit . 5 = 'CHAINE' 'CGS' ;
tabprec = 'TABLE' ;
tabprec . 0 = 'CHAINE' 'Rien' ;
tabprec . 1 = 'CHAINE' 'Diag' ;
tabprec . 2 = 'CHAINE' 'DILU' ;
tabprec . 3 = 'CHAINE' 'ILU(0)' ;
tabprec . 4 = 'CHAINE' 'MILU(0)' ;
tabprec . 5 = 'CHAINE' 'ILUT' ;
tabprec . 6 = 'CHAINE' 'ILUT2' ;
tabprec . 7 = 'CHAINE' 'ILUTP' ;
tabprec . 8 = 'CHAINE' 'ILUTP+0' ;
tabpec = 'TABLE' ;
tabpec  . 1 = 1.D-4 ;
tabpec  . 2 = 1.D-2 ;
tabpec  . 3 = 1.D-1 ;
tabpec  . 4 = 1.D0  ;
tabpec  . 5 = 5.D0  ;
*
* Valeur du Péclet de maille : Pem
*
xini = 'NOMC' 'T' ('BRUIT' 'BLAN' 'UNIF' 0.5 0.5 mt) ;
*
* Tous les péclets BiCGSTAB(4) + ILU(0)
*
tres = 'TABLE' ;
tres . 'EVOS' = 'TABLE' ;
tres . 'OK'   = 'TABLE' ;
tres . 'NIT'   = 'TABLE' ;
tres . 'TCPU'   = 'TABLE' ;
'REPETER' ipec ('DIME' tabpec) ;
   Pem = tabpec . &ipec ;
   mtot ftot sol = DISCR Pem ;
   'TEMPS' 'ZERO' ;
   rv = 'EQEX' ; rvm = rv . 'METHINV' ;
   rvm . 'TYPINV' = 4 ;
   rvm . 'PRECOND' = 3 ;
   rvm . 'CALRES'  = 1 ;
   rvm . 'XINIT' = xini ;
   res  = 'EXCO' 'T' ('KRES' mtot ftot 'TYPI' rvm) 'T' ;
   lnmv = 'FLOTTANT' (rvm . 'NMATVEC') ;
   lres = rvm . 'CONVINV' ;
   tres . 'EVOS' . &ipec  = 'EVOL' 'MANU' lnmv (log10 lres) ;
   tres . 'OK'   . &ipec  = 'MAXIMUM' ('-' res sol) 'ABS' ;
   tres . 'NIT'  . &ipec  = 'EXTRAIRE' lnmv ('DIME' lnmv) ;
   TABTPS = TEMP 'NOEC';
   tres . 'TCPU' . &ipec  =  TABTPS.'TEMPS_CPU'.'INITIAL';
'FIN' ipec ;
* Tableau récapitulatif
'SAUTER' 1 'LIGNE' ;
cc = 'CHAINE' 'Conv-diff BLOQ BiCGSTAB(4) + ILU(0) ' ;
'MESSAGE' cc ;
cc3 = 'CHAINE' 'Nb pmatvec'/20 'Temps CPU'/40 'Erreur'/60 ;
'MESSAGE' cc3 ;
'REPETER' ipec ('DIME' tabpec) ;
   nit = tres . 'NIT' . &ipec ;
   tcpu = tres . 'TCPU' . &ipec ;
   ok = tres . 'OK' . &ipec ;
   cc4 = 'CHAINE' 'Pem=' (formar (tabpec . &ipec))
                  nit*30 (formar tcpu 2)*50
                         (formar ok 4)*70 ;
   'MESSAGE' cc4 ;                               
'FIN' ipec ;
'SAUTER' 1 'LIGNE' ;
* Graphique
'SI' graph ;
   evtot = @STBL (tres . 'EVOS') ;
   tabt = 'TABLE' ;
   'REPETER' ipec ('DIME' tabpec) ;
      tabt . &ipec = 'CHAINE' 'Pem=' (formar (tabpec . &ipec)) ;
   'FIN' ipec ;
   tit = 'CHAINE' 'Conv-diff BLOQ BiGSTAB(4)+ILU(0) ' ;      
   titx = 'CHAINE' 'Nb pmatvec' ;      
   tity = 'CHAINE' 'Log10 critere' ;      
   DESSEVOL evtot tabt tit titx tity FAUX ;
'FINSI' ;
*
* Toutes les méthodes avec ILU(0) Pem = 1.D0
*
Pem = 1.0D0 ;
mtot ftot sol = DISCR Pem ;
tres = 'TABLE' ;
tres . 'EVOS' = 'TABLE' ;
tres . 'OK'   = 'TABLE' ;
tres . 'NIT'   = 'TABLE' ;
tres . 'TCPU'   = 'TABLE' ;
'REPETER' imetit ('DIME' tabmit) ;
   'TEMPS' 'ZERO' ;
   rv = 'EQEX' ; rvm = rv . 'METHINV' ;
   rvm . 'TYPINV' = &imetit '+' 1 ;
   rvm . 'PRECOND' = 3 ;
   rvm . 'CALRES'  = 1 ;
   rvm . 'XINIT' = xini ;
   res  = 'EXCO' 'T' ('KRES' mtot ftot 'TYPI' rvm) 'T' ;
   lnmv = 'FLOTTANT' (rvm . 'NMATVEC') ;
   lres = rvm . 'CONVINV' ;
   tres . 'EVOS' . &imetit  = 'EVOL' 'MANU' lnmv (log10 lres) ;
   tres . 'OK'   . &imetit  = 'MAXIMUM' ('-' res sol) 'ABS' ;
   tres . 'NIT'  . &imetit  = 'EXTRAIRE' lnmv ('DIME' lnmv) ;
   TABTPS = TEMP 'NOEC';
   tres . 'TCPU' . &imetit  =  TABTPS.'TEMPS_CPU'.'INITIAL';
'FIN' imetit ;
* Tableau récapitulatif
'SAUTER' 1 'LIGNE' ;
cc = 'CHAINE' 'Conv-diff BLOQ ILU(0) Pem=' (formar Pem) ;
'MESSAGE' cc ;
cc3 = 'CHAINE' 'Nb pmatvec'/20 'Temps CPU'/40 'Erreur'/60 ;
'MESSAGE' cc3 ;
'REPETER' imetit ('DIME' tabmit) ;
   nit = tres . 'NIT' . &imetit ;
   tcpu = tres . 'TCPU' . &imetit ;
   ok = tres . 'OK' . &imetit ;
   cc4 = 'CHAINE' (tabmit . &imetit)
                  nit*30 (formar tcpu 2)*50
                         (formar ok 4)*70 ;
   'MESSAGE' cc4 ;                               
'FIN' imetit ;
'SAUTER' 1 'LIGNE' ;
* Graphique
'SI' graph ;
   evtot = @STBL (tres . 'EVOS') ;
   tabt = 'TABLE' ;
   'REPETER' imetit ('DIME' tabmit) ;
      tabt . &imetit = tabmit . &imetit ;
   'FIN' imetit ;
   tit = 'CHAINE' 'Conv-diff BLOQ ILU(0) Pem=' (formar Pem) ;      
   titx = 'CHAINE' 'Nb pmatvec' ;      
   tity = 'CHAINE' 'Log10 critere' ;      
   DESSEVOL evtot tabt tit titx tity FAUX ;
'FINSI' ;
*
* Le test vérifie que toutes méthodes (à part CG) ont donné
* une erreur inférieure à 1.D-2
*
test = VRAI ;
'REPETER' imetit ('-' ('DIME' tabmit) 1) ;
   ok = tres . 'OK' . ('+' &imetit 1) ;
   test = test 'ET' ('<' ok 1.D-2) ;
'FIN' imetit ;
*
* Tous les préconditionneurs BiCGSTAB(4) Pem = 1.D0
*
Pem = 1.D0 ;
mtot ftot sol = DISCR Pem ;
tres = 'TABLE' ;
tres . 'EVOS' = 'TABLE' ;
tres . 'OK'   = 'TABLE' ;
tres . 'NIT'   = 'TABLE' ;
tres . 'TCPU'   = 'TABLE' ;
'REPETER' iprec ('DIME' tabprec) ;
   'TEMPS' 'ZERO' ;
   rv = 'EQEX' ; rvm = rv . 'METHINV' ;
   rvm . 'TYPINV' = 4 ;
   rvm . 'PRECOND' = '-' &iprec 1 ;
   rvm . 'CALRES'  = 1 ;
   rvm . 'XINIT' = xini ;
   res  = 'EXCO' 'T' ('KRES' mtot ftot 'TYPI' rvm) 'T' ;
   lnmv = 'FLOTTANT' (rvm . 'NMATVEC') ;
   lres = rvm . 'CONVINV' ;
   tres . 'EVOS' . &iprec  = 'EVOL' 'MANU' (log10 lnmv) (log10 lres) ;
   tres . 'OK'   . &iprec  = 'MAXIMUM' ('-' res sol) 'ABS' ;
   tres . 'NIT'  . &iprec  = 'EXTRAIRE' lnmv ('DIME' lnmv) ;
   TABTPS = TEMP 'NOEC';
   tres . 'TCPU' . &iprec  =  TABTPS.'TEMPS_CPU'.'INITIAL';
'FIN' iprec ;
* Tableau récapitulatif
'SAUTER' 1 'LIGN' ;
cc = 'CHAINE' 'Conv-diff BLOQ BiCGSTAB(4) Pem=' (formar Pem) ;
'MESSAGE' cc ;
cc3 = 'CHAINE' 'Nb pmatvec'/20 'Temps CPU'/40 'Erreur'/60 ;
'MESSAGE' cc3 ;
'REPETER' iprec ('DIME' tabprec) ;
   nit = tres . 'NIT' . &iprec ;
   tcpu = tres . 'TCPU' . &iprec ;
   ok = tres . 'OK' . &iprec ;
   cc4 = 'CHAINE' (tabprec . ('-' &iprec 1))
                  nit*30 (formar tcpu 2)*50
                         (formar ok 4)*70 ;
   'MESSAGE' cc4 ;                               
'FIN' iprec ;
'SAUTER' 1 'LIGNE' ;
* Graphique
'SI' graph ;
   evtot = @STBL (tres . 'EVOS') ;
   tabt = 'TABLE' ;
   'REPETER' iprec ('DIME' tabprec) ;
      tabt . &iprec = tabprec . ('-' &iprec 1) ;
   'FIN' iprec ;
   tit = 'CHAINE' 'Conv-diff BLOQ BiGSTAB(4) Pem= ' (formar Pem) ;      
   titx = 'CHAINE' 'Log10 Nb pmatvec' ;      
   tity = 'CHAINE' 'Log10 critere' ;      
   DESSEVOL evtot tabt tit titx tity FAUX ;
'FINSI' ;
*
'SI' ('NON' test) ;
   'ERREUR' 5 ;
'FINSI' ;   
*
'SI' interact ;
   'OPTION' 'DONN' 5 ;
'FINSI' ;   
*
* End of dgibi file KRES_CD2
*
'FIN' ;
 
 
 
 
 
 

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