Télécharger drop.dgibi

Retour à la liste

* fichier : drop.dgibi
************************************************************************
************************************************************************
*
'OPTI' 'ECHO' 0 ;
*
'SAUTER' 2 'LIGNE' ;
'MESSAGE' ' Execution de drop.dgibi' ;
'SAUTER' 2 'LIGNE' ;
*
graph = faux ;
complet = faux ;
interact = faux ;
lmatrik = faux ;
************************************************************************
* NOM         : DROP 
* DESCRIPTION : Une goutte plane ou axi soumise à la gravité et à
*               la tension de surface.
*               Contraintes : on fixe le Delta P ou le Volume
*                             on fixe la position des points ou l'angle
*                             (cf. table tclim)
*
*               A plane or axisymmetric drop subject to surface tension
*               and gravity and to the following constraints or forces
*               1) Constant volume or constant pressure difference
*                  between the interior and exterior
*               2) On the triple line: given contact angle or given
*                  position 
*                  (see tclim TABLE)
* 
*  Reference solution :
*  -> No gravity : the drop is spherical => analytical solution
*  -> upward gravity : 
*@Article{sumesh,
*  author =       {P.T. Sumesh and Rama Govindrajan},
*  title =        {The possible equilibrium shapes of static pendant drops},
*  journal =      {The Journal of Chemical Physics},
*  year =         {2010},
*  key = {144707},
*  volume =    {133},
*  pages =     {1--8},
*}
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011, version initiale
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
 'OPTION' 'DIME' 2 'ELEM' 'QUA4' 'MODE' 'PLAN' ;
************************************************************************
*
* 
*   PROCEDURES 
*
*
************************************************************************
*BEGINPROCEDUR affvar
************************************************************************
* NOM         : AFFVAR
* DESCRIPTION : Affiche des variables
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
*
*
'DEBPROC' AFFVAR ;
'REPETER' bcl ;
   'ARGUMENT' x/'FLOTTANT' ;
   'SI' ('EXISTE' x) ;
      'ARGUMENT' lx*'MOT' ;
      'MESSAGE' ('CHAINE' lx '=' x) ;
   'SINON' ;
      'QUITTER' bcl ;
   'FINSI' ;
'FIN' bcl ;
'FINPROC' ;         
*
* End of procedure file AFFVAR
*
*ENDPROCEDUR affvar
*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 errrel
************************************************************************
* NOM         : ERRREL
* DESCRIPTION : Calcul d'une erreur relative
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 23/04/2003, version initiale
* HISTORIQUE : v1, 23/04/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' ERRREL ;
'ARGUMENT' val*'FLOTTANT' ;
'ARGUMENT' valref*'FLOTTANT' ;
*
'SI' ('<' ('ABS' valref) 1.D-10) ;
   echref = 1.D0 ;
'SINON' ;
   echref = valref ;   
'FINSI' ;
*
errabs = 'ABS' ('/' ('-' val valref) echref);
*
'RESPRO' errabs ;
*
* End of procedure file ERRREL
*
'FINPROC' ;
*ENDPROCEDUR errrel
*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 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 getcoo
************************************************************************
* NOM         : GETCOO
* DESCRIPTION :
* Renvoie les coordonnées des points dans un champ type déplacement
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011, version initiale
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' GETCOO ;
'ARGUMENT' mail*'MAILLAGE' ;
'ARGUMENT' incop*'LISTMOTS' ;
*
dim = 'VALEUR' 'DIME' ;
'REPETER' iidim dim ;
   idim= &iidim ;
   icoo = 'NOMC' ('EXTRAIRE' incop idim)
                 ('COORDONNEE' idim mail) ;
   'SI' ('EGA' idim 1) ;
      vcoo = icoo ;
   'SINON' ;
      vcoo = 'ET' vcoo icoo ;
   'FINSI' ;
'FIN' iidim ;
'RESPRO' vcoo ;
*
* End of procedure file GETCOO
*
'FINPROC' ;
*ENDPROCEDUR getcoo
*BEGINPROCEDUR ggravi
************************************************************************
* NOM         : GGRAVI
* DESCRIPTION : Calcul de la force associée au potentiel gravitaire
*               (\rho g z si g vertical)
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' GGRAVI ;
'ARGUMENT' _surf*'MAILLAGE' ;
'ARGUMENT' tdisc*'TABLE' ;
'ARGUMENT' coef*'FLOTTANT' ;
'ARGUMENT' ang*'FLOTTANT' ;
*
vdim = 'VALEUR' 'DIME' ;
pgrax  = '*' ('COORDONNEE' 1 _surf) ('*' +1. ('SIN' ang)) ;
pgraz  = '*' ('COORDONNEE' vdim _surf) ('*' -1. ('COS' ang)) ;
DISCG  = TDISC . 'GEOM' . 'DISC' ;
fpgrax = GNOR _surf tdisc 'NPRI' discg 'CPRI' pgrax 'NDUA' 'XN' ;
fpgraz = GNOR _surf tdisc 'NPRI' discg 'CPRI' pgraz 'NDUA' 'XN' ;
fpgra = '+' fpgrax fpgraz ;
fpgra = '*' fpgra ('*' -1. coef) ;
'RESPRO' fpgra ;
*
* End of procedure file GGRAVI
*
'FINPROC' ;
*ENDPROCEDUR ggravi
*BEGINPROCEDUR gkgravi
************************************************************************
* NOM         : GKGRAVI
* DESCRIPTION : Calcul de la matrice tangente de la force
*               associée au potentiel gravitaire (calculée par GGRAVI)
*               en fonction des déplacements des points de la surface.
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' GKGRAVI ;
'ARGUMENT' _surf*'MAILLAGE' ;
'ARGUMENT' tdisc*'TABLE' ;
'ARGUMENT' ijaco*'ENTIER' ;
*'SI' ('NON' ('EXISTE' ijaco)) ;
*   ijaco = 0 ;
*'FINSI' ;   
'ARGUMENT' coef*'FLOTTANT' ;
'ARGUMENT' ang*'FLOTTANT' ;
*
vdim = 'VALEUR' 'DIME' ;
pgrax  = '*' ('COORDONNEE' 1 _surf) ('*' +1. ('SIN' ang)) ;
pgraz  = '*' ('COORDONNEE' vdim _surf) ('*' -1. ('COS' ang)) ;
*pgra  = '*' ('-' ('COORDONNEE' vdim _surf) H) -1. ;
*pgra  = '*' ('COORDONNEE' vdim _surf) -1. ;
DISCG  = TDISC . 'GEOM' . 'DISC' ;
NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
*fpgra = GNOR _surf tdisc 'NPRI' discg 'CPRI' pgra 'NDUA' 'XN' ;
   k1x = GNOR _surf tdisc 'NPRI' discg 'NDUA' 'XN' ;
   k1x = '*' k1x ('*' +1. ('SIN' ang)) ;
   k1x = 'CHANGER' 'INCO' k1x ('MOTS' 'SCAL')
            ('MOTS' ('EXTRAIRE' NOMDEP 1)) NOMDEP NOMDEP ;
   k2x = GNORKTAN _surf tdisc 'NPRI' 'XN'
        'NCOF' discg 'CCOF' pgrax 'NDUA' 'XN' ;
   k1z = GNOR _surf tdisc 'NPRI' discg 'NDUA' 'XN' ;
   k1z = '*' k1z ('*' -1. ('COS' ang)) ;
   k1z = 'CHANGER' 'INCO' k1z ('MOTS' 'SCAL')
            ('MOTS' ('EXTRAIRE' NOMDEP vdim)) NOMDEP NOMDEP ;
   k2z = GNORKTAN _surf tdisc 'NPRI' 'XN'
        'NCOF' discg 'CCOF' pgraz 'NDUA' 'XN' ;
   'SI' ('EGA' ijaco 0) ;
      ktgra = k1x 'ET' k1z 'ET' k2x 'ET' k2z ;
   'FINSI' ;
   'SI' ('EGA' ijaco 1) ;
      ktgra = k1x 'ET' k1z ;
   'FINSI' ;      
   'SI' ('EGA' ijaco 2) ;
      ktgra = k2x 'ET' k2z ;
   'FINSI' ;
   ktgra = '*' ktgra coef ;
'RESPRO' ktgra ;
*
* End of procedure file GKGRAVI
*
'FINPROC' ;
*ENDPROCEDUR gkgravi
*BEGINPROCEDUR gkvol
************************************************************************
* NOM         : GKVOL
* DESCRIPTION : Matrice tangente associée à la variation du volume
*               contenu dans une surface (calculé par GVOL)
*               en fonction des déplacements des points de la surface.
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011, version initiale
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' GKVOL ;
'ARGUMENT' _surf*'MAILLAGE' ;
'ARGUMENT' tdisc*'TABLE' ;
'ARGUMENT' ijaco/'ENTIER' ;
'SI' ('NON' ('EXISTE' ijaco)) ;
   ijaco = 0 ;
'FINSI' ;   
*  Vecteur position et calcul du volume
NOMVIT = @STBL (TDISC . 'XN' . 'NOMINC') ;
DISCG  = TDISC . 'GEOM' . 'DISC' ;
vdim = 'VALEUR' 'DIME' ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
      fdim = 3 ;
   'SINON' ;
      fdim = vdim ;
   'FINSI' ;
   vpos = GETCOO _surf nomvit ;
   kvol1 = GNOR _surf tdisc 'NPRI' ('CHAINE' discg 'V')
                             'NDUA' 'XN' 'FDUA' ('PROG' vdim * 1.) ;
   kvol2 = GNORKTAN _surf tdisc 'NPRI' ('CHAINE' discg 'V')
            'NCOF' ('CHAINE' discg 'V') 'CCOF' vpos
            'NDUA' 'XN' 'FDUA' ('PROG' vdim * 1.) ;
   'SI' ('EGA' ijaco 0) ;            
      kvol = '/' ('+' kvol1 kvol2) fdim ;
   'FINSI' ;
   'SI' ('EGA' ijaco 1) ;
      kvol = '/' kvol1 fdim ;
   'FINSI' ;      
   'SI' ('EGA' ijaco 2) ;
      kvol = '/' kvol2 fdim ;
   'FINSI' ;      
'RESPRO' kvol ;
*
* End of procedure file GKVOL
*
'FINPROC' ;
*ENDPROCEDUR gkvol
*BEGINPROCEDUR gmass2
************************************************************************
* NOM         : GMASS2
* 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' GMASS2 ;
'ARGUMENT'     _mt*'MAILLAGE' ;
'ARGUMENT'     _smt/'MAILLAGE' ;
'ARGUMENT' tdisc*'TABLE' ;
*
* Lectures
*
debug = FAUX ;
lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
                 'NCOF' 'FCOF' 'CCOF' ;
* Il faut initialiser valt et valq, sinon on peut capturer ceux de
* la procédure appelante
valt = 'valt' ; valq = 'valq' ;
'REPETER' imotcle ;
   'ARGUMENT' motcle/'MOT' ;
   'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
   'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
      cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
   'FINSI' ;
   'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
   tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
   tst = tst1 'OU' tst2 ;
   'SI' tst ;
      'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
      'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
      isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
      'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
         'ARGUMENT' valv*'FLOTTANT' ;
      'FINSI' ;
      'SI' tst1 ; valt = valv ; 'FINSI' ;
      'SI' tst2 ; valq = valv ; 'FINSI' ;
   'FINSI' ;
   'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
'FIN' imotcle ;
*
* Tests
*
discg = TDISC . 'GEOM' . 'DISC' ;
'SI' ('EXISTE' tdisc 'methgau') ;
   methgau = tdisc . 'methgau' . 'mass' ;
'SINON' ;
   methgau = 'GAU7' ;
'FINSI' ;
tnomt = TDISC . nomt ;
lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
tnomq = TDISC . nomq ;
lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
* Scalaire ou vecteur
ninct = 'DIME' (tnomt . 'NOMINC') ;
nincq = 'DIME' (tnomq . 'NOMINC') ;
'SI' ('NEG' ninct nincq) ;
   cherr = 'CHAINE'
   'les primales et duales nont pas le meme nombre de composantes' ;
   'ERREUR' cherr ;
'FINSI' ;   
ninc = ninct ;
*
lcof = 'EXISTE' TDISC nomo ;
'SI' lcof ; ncof = 1 ; tcof = TDISC . nomo ;
'SINON' ; ncof = 0 ;
'FINSI' ;
*
'SI' debug ;
'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
'SINON' ; 'MESSAGE' 'pas de coef  detecte' ;
'FINSI' ;
'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' ;
*   'MESSAGE' ('CHAINE' 'iaxi=' iaxi ); 
   'SI' ('EGA' idim 0) ;
      'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
   'FINSI' ;
   'SI' iaxi ;
      dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
   'FINSI' ;
*
* Optimisation possible : construire la matrice par blocs
* qd valt et valq ne sont pas donnés
*
   numop = ninc ; numder = idim ; numvar = ninc ;
   numdat = ncof ; numcof = ncof ;
   A = ININLIN numop numvar numdat numcof numder ;
   'SI' lcof ;
      A . 'DAT' . 1 . 'NOMDDL' = tcof . 'NOMINC' . 1 ;
      A . 'DAT' . 1 . 'DISC'   = tcof . 'DISC' ;
      A . 'DAT' . 1 . 'VALEUR' = valo ;
      A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
      A . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
      ll = 'LECT' 1 ;
   'SINON' ;
      ll = 'LECT' ;
   'FINSI' ;
   lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
   'REPETER' iiinc ninc ;
      iinc = &iiinc ;
      A . 'VAR' . iinc . 'NOMDDL' = tnomt . 'NOMINC' . iinc ;
      A . 'VAR' . iinc . 'DISC'   = tnomt . 'DISC'  ;
      'SI' lvalt ;
         'SI' lvt ;
            A . 'VAR' . iinc . 'VALEUR'   = 'EXTRAIRE' valt iinc ;
         'SINON' ;
            A . 'VAR' . iinc . 'VALEUR'   = valt ;
         'FINSI' ;            
      'FINSI' ;         
      A . iinc . iinc . 0  = ll ;
   'FIN' iiinc ;
*
   'SI' iaxi ;
      numdat = 1 ;
      numcof = 1 ;
   'SINON' ;      
      numdat = 0 ;
      numcof = 0 ;
   'FINSI' ;      
   B = ININLIN numop numvar numdat numcof numder ;
   'SI' iaxi ;
      B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      B . 'DAT' . 1 . 'DISC'   = discg ;
      B . 'DAT' . 1 . 'VALEUR' = dprmt ;
      B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
      B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
      ll = 'LECT' 1 ;
   'SINON' ;
      ll = 'LECT' ;
   'FINSI' ;
   lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
   'REPETER' iiinc ninc ;
      iinc = &iiinc ;
      B . 'VAR' . iinc . 'NOMDDL' = tnomq . 'NOMINC' . iinc ;
      B . 'VAR' . iinc . 'DISC'   = tnomq . 'DISC'  ;
      'SI' lvalq ;
         'SI' lvq ;
            B . 'VAR' . iinc . 'VALEUR'   = 'EXTRAIRE' valq iinc ;
         'SINON' ;
            B . 'VAR' . iinc . 'VALEUR'   = valq ;
         'FINSI' ;            
      'FINSI' ;         
      B . iinc . iinc . 0  = ll ;
   'FIN' iiinc ;
*
   'SI' ('EXISTE' _smt) ;
       mgmass2 = 'NLIN' discg _mt _smt A B methgau ;
   'SINON' ;       
       mgmass2 = NLINP discg _mt A B methgau ;
   'FINSI' ;       
*
'RESPRO' mgmass2 ;
'FINPROC' ;
*
* End of procedure file GMASS2
*
*ENDPROCEDUR gmass2
*BEGINPROCEDUR gnorktan
************************************************************************
* NOM         : GNORKTAN
* DESCRIPTION : Matrice tangente associée à la variation de la normale
*               à une surface (calculée par GNOR)
*               en fonction des déplacements des points de la surface.
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011, version initiale
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' GNORKTAN ;
'ARGUMENT'     _mt*'MAILLAGE' ;
'ARGUMENT' tdisc*'TABLE' ;
*
* Lectures
*
dim = 'VALEUR' 'DIME' ;
mdim = DEADUTIL 'DIMM' _mt ;
'SI' ('NEG' mdim ('-' dim 1)) ;
   'ERREUR' 'Dim. maillage .neq. dim. espace - 1' ;
'FINSI' ;   
loi  = 'CHAINE' 'VNOJ' ;
debug = FAUX ;
lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
                 'NCOF' 'FCOF' 'CCOF' ;
* Il faut initialiser valt et valq, sinon on peut capturer ceux de
* la procédure appelante
valt = 'valt' ; valq = 'valq' ;
'REPETER' imotcle ;
   'ARGUMENT' motcle/'MOT' ;
   'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
   'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
      cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
   'FINSI' ;
   'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
   tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
   tst = tst1 'OU' tst2 ;
   'SI' tst ;
      'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
      'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
      isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
      'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
         'ARGUMENT' valv*'FLOTTANT' ;
      'FINSI' ;
      'SI' tst1 ; valt = valv ; 'FINSI' ;
      'SI' tst2 ; valq = valv ; 'FINSI' ;
   'FINSI' ;
   'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
'FIN' imotcle ;
*
* Tests
*
discg = TDISC . 'GEOM' . 'DISC' ;
'SI' ('EXISTE' tdisc 'methgau') ;
   methgau = tdisc . 'methgau' . 'mass' ;
'SINON' ;
   methgau = 'GAU7' ;
'FINSI' ;
tnomt = TDISC . nomt ;
lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
tnomq = TDISC . nomq ;
lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
* Scalaire ou vecteur
ninct = 'DIME' (tnomt . 'NOMINC') ;
nincq = 'DIME' (tnomq . 'NOMINC') ;
'SI' ('NEG' ninct dim) ;
   cherr = 'CHAINE'
   'la primale doit etre un vecteur' ;
   'ERREUR' cherr ;
'FINSI' ;   
'SI' ('NEG' nincq dim) ;
   cherr = 'CHAINE'
   'la duale doit etre un vecteur' ;
   'ERREUR' cherr ;
'FINSI' ;   
ninc = dim ;
*
lcof = 'EXISTE' TDISC nomo ;
'SI' lcof ; tcof = TDISC . nomo ;
ncof = 'DIME' (tcof . 'NOMINC') ;
'SINON' ; ncof = 0 ;
'FINSI' ;
*
'SI' debug ;
'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
'SINON' ; 'MESSAGE' 'pas de coef  detecte' ;
'FINSI' ;
'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' ;
*   'MESSAGE' ('CHAINE' 'iaxi=' iaxi ); 
   'SI' ('EGA' idim 0) ;
      'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
   'FINSI' ;
   'SI' iaxi ;
      deupi = '*' PI 2.D0 ;
      dprmt = '*' ('COORDONNEE' 1 _mt) deupi ;
   'FINSI' ;
*
* Optimisation possible : construire la matrice par blocs
* qd valt et valq ne sont pas donnés
*
   numop = idim '*' idim '*' idim ;
   'SI' iaxi ;
      numop = numop '+' idim ;
   'FINSI' ;
   numder = idim ; numvar = ninct ;
   numdat = ncof ; numcof = ncof ;
   A = ININLIN numop numvar numdat numcof numder ;
   'SI' lcof ;
      lvo = 'EGA' ('TYPE' valo) 'LISTREEL' ;
      'REPETER' iicof ncof ;
         icof = &iicof ;
         A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . icof ;
         A . 'DAT' . icof . 'DISC'   = tcof . 'DISC' ;
         'SI' lvo ;
            A . 'DAT' . icof . 'VALEUR' = 'EXTRAIRE' valo icof ;
         'SINON' ;            
            A . 'DAT' . icof . 'VALEUR' = valo ;
         'FINSI' ;            
         A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
         A . 'COF' . icof . 'LDAT'   = 'LECT' icof ;
      'FIN' iicof ;         
   'SINON' ;
      ll = 'LECT' ;
   'FINSI' ;
   lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
   iop = 0 ;
   'REPETER' iiinct ninct ;
      iinct = &iiinct ;
      A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
      A . 'VAR' . iinct . 'DISC'   = tnomt . 'DISC'  ;
      'SI' lvalt ;
         'SI' lvt ;
            A . 'VAR' . iinct . 'VALEUR'   = 'EXTRAIRE' valt iinct ;
         'SINON' ;
            A . 'VAR' . iinct . 'VALEUR'   = valt ;
         'FINSI' ;            
      'FINSI' ;
      'REPETER' iiincq nincq ;
         'REPETER' iiider numder ;
            iop = '+' iop 1 ;
            'SI' lcof ;
               icof = 'MINIMUM' ('LECT' &iiincq ncof) ;
               A . iop . iinct . &iiider = 'LECT' icof ;
            'SINON' ;               
               A . iop . iinct . &iiider = ll ;
            'FINSI' ;               
         'FIN' iiider ;
      'FIN' iiincq ;         
   'FIN' iiinct ;
   'SI' iaxi ;
      'REPETER' iiincq nincq ;
         iop = '+' iop 1 ;
         'SI' lcof ;
            icof = 'MINIMUM' ('LECT' &iiincq ncof) ;
            A . iop . 1 . 0 = 'LECT' icof ;
         'SINON' ;               
            A . iop . 1 . 0 = ll ;
         'FINSI' ;               
      'FIN' iiincq ;         
   'FINSI' ;
*
*   'SI' iaxi ;
*      numdat = 1 ;
*      numcof = dim '+' 1 ;
*   'SINON' ;      
      numdat = 0 ;
      numcof = idim '*' idim '*' idim ;
*   'FINSI' ;
   'SI' iaxi ;
      numdat = '+' numdat 2 ;
      numcof = '+' numcof ('+' idim 2) ;
   'FINSI' ;      
   numvar = nincq ;
   B = ININLIN numop numvar numdat numcof numder ;
*
   lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
   'REPETER' iiinc nincq ;
      iinc = &iiinc ;
      B . 'VAR' . iinc . 'NOMDDL' = tnomq . 'NOMINC' . iinc ;
      B . 'VAR' . iinc . 'DISC'   = tnomq . 'DISC'  ;
      'SI' lvalq ;
         'SI' lvq ;
            B . 'VAR' . iinc . 'VALEUR'   = 'EXTRAIRE' valq iinc ;
         'SINON' ;
            B . 'VAR' . iinc . 'VALEUR'   = valq ;
         'FINSI' ;            
      'FINSI' ;         
   'FIN' iiinc ;
   idat = 0 ;
   icof = 0 ;
   'SI' iaxi ;
      'REPETER' iiidim idim ;
         icof = '+' icof 1 ;
         B . 'COF' . icof . 'COMPOR' = 'CHAINE' 'VNOR' &iiidim ;
         B . 'COF' . icof . 'LDAT'   = 'LECT' ;
      'FIN' iiidim ;
      idat = '+' idat 1 ;
      icof = '+' icof 1 ;
      B . 'DAT' . idat . 'NOMDDL' = 'MOTS' 'SCAL' ;
      B . 'DAT' . idat . 'DISC'   = discg ;
      B . 'DAT' . idat . 'VALEUR' = dprmt ;
      B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
      B . 'COF' . icof . 'LDAT'   = 'LECT' idat ;
      ll = 'LECT' icof ;
      idat = '+' idat 1 ;
      icof = '+' icof 1 ;
      B . 'DAT' . idat . 'NOMDDL' = 'MOTS' 'SCAL' ;
      B . 'DAT' . idat . 'DISC'   = 'CSTE' ;
      B . 'DAT' . idat . 'VALEUR' = deupi ;
      B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
      B . 'COF' . icof . 'LDAT'   = 'LECT' idat ;
      ll2 = 'LECT' icof ;
   'SINON' ;
      ll = 'LECT' ;
   'FINSI' ;
*
  iop = 0 ;   
  'REPETER' iiinct ninct ;
     'REPETER' iiincq nincq ;
         'REPETER' iiider numder ;
            iop  = '+' iop 1 ;
            icof = '+' icof 1 ;
            lcomp = 'CHAINE' loi &iiincq &iiinct &iiider ;
*            lcomp = 'CHAINE' loi &iiinct &iiincq &iiider ;
            B . 'COF' . icof . 'COMPOR' = lcomp ;
            B . 'COF' . icof . 'LDAT'   = 'LECT' ;
            B . iop . &iiincq . 0 = ('LECT' icof) 'ET' ll ;
         'FIN' iiider ;
      'FIN' iiincq ;
   'FIN' iiinct ;
   'SI' iaxi ;
      'REPETER' iiincq nincq ;
         iincq = &iiincq ;
         iop = '+' iop 1 ;
         B . iop . iincq . 0 = ('LECT' iincq) 'ET' ll2 ;
      'FIN' iiincq ;         
   'FINSI' ;
*
*   mgnorkt = NLIN discg _mt A B 'CRES' methgau ;
   mgnorkt = NLIN discg _mt A B methgau ;
*
'RESPRO' mgnorkt ;
'FINPROC' ;
*
* End of procedure file GNORKTAN
*
*ENDPROCEDUR gnorktan
*BEGINPROCEDUR gnor
************************************************************************
* NOM         : GNOR
* DESCRIPTION : Calcule le champ de normales à une surface.
*               Peut servir à calculer une pression, un potentiel
*               lié à la gravité, un volume contenu dans une surface.
*               Attention à l'orientation de la surface !
*
*               Computes a field of normal to a surface.
*               Also useful to compute a pressure field,
*               a gravity potential field, a volume enclosed
*               by a surface.
*               WARNING : The orientation of the surface matters !
*
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' GNOR ;
'ARGUMENT'     _mt*'MAILLAGE' ;
'ARGUMENT' tdisc*'TABLE' ;
*
* Lectures
*
dim = 'VALEUR' 'DIME' ;
debug = FAUX ;
lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
                 'NCOF' 'FCOF' 'CCOF' ;
* Il faut initialiser valt et valq, sinon on peut capturer ceux de
* la procédure appelante
valt = 'valt' ; valq = 'valq' ;
'REPETER' imotcle ;
   'ARGUMENT' motcle/'MOT' ;
   'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
   'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
      cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
   'FINSI' ;
   'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
   tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
   tst3 = 'EGA' motcle 'FCOF' ;
   tst = tst1 'OU' tst2 'OU' tst3 ;
   'SI' tst ;
      'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
      'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
      'SI' tst3 ; tt = TDISC . nomo ; 'FINSI' ;
      isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
      'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
         'ARGUMENT' valv*'FLOTTANT' ;
      'FINSI' ;
      'SI' tst1 ; valt = valv ; 'FINSI' ;
      'SI' tst2 ; valq = valv ; 'FINSI' ;
      'SI' tst3 ; valo = valv ; 'FINSI' ;
   'FINSI' ;
   'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
   'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
'FIN' imotcle ;
*
* Tests
*
discg = TDISC . 'GEOM' . 'DISC' ;
'SI' ('EXISTE' tdisc 'methgau') ;
   methgau = tdisc . 'methgau' . 'mass' ;
'SINON' ;
   methgau = 'GAU7' ;
'FINSI' ;
tnomt = TDISC . nomt ;
lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
tnomq = TDISC . nomq ;
lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
* Scalaire ou vecteur
ninct = 'DIME' (tnomt . 'NOMINC') ;
nincq = 'DIME' (tnomq . 'NOMINC') ;
'SI' ('ET' ('NEG' ninct 1) ('NEG' ninct dim)) ;
   cherr = 'CHAINE'
   'la primale doit etre un scalaire ou un vecteur' ;
   'ERREUR' cherr ;
'FINSI' ;   
'SI' ('NEG' nincq dim) ;
   cherr = 'CHAINE'
   'la duale doit etre un vecteur' ;
   'ERREUR' cherr ;
'FINSI' ;   
*ninc = ninct ;
*
lcof = 'EXISTE' TDISC nomo ;
'SI' lcof ; tcof = TDISC . nomo ;
ncof = 'DIME' (tcof . 'NOMINC') ;
'SINON' ; ncof = 0 ;
'FINSI' ;
*
'SI' debug ;
'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
'SINON' ; 'MESSAGE' 'pas de coef  detecte' ;
'FINSI' ;
'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' ;
*   'MESSAGE' ('CHAINE' 'iaxi=' iaxi ); 
   'SI' ('EGA' idim 0) ;
      'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
   'FINSI' ;
   'SI' iaxi ;
      dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
   'FINSI' ;
*
* Optimisation possible : construire la matrice par blocs
* qd valt et valq ne sont pas donnés
*
   numop = nincq ; numder = idim ; numvar = ninct ;
   numdat = ncof ; numcof = ncof ;
   A = ININLIN numop numvar numdat numcof numder ;
   'SI' lcof ;
      lvo = 'EGA' ('TYPE' valo) 'LISTREEL' ;
      'REPETER' iicof ncof ;
         icof = &iicof ;
         A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . icof ;
         A . 'DAT' . icof . 'DISC'   = tcof . 'DISC' ;
         'SI' lvo ;
            A . 'DAT' . icof . 'VALEUR' = 'EXTRAIRE' valo icof ;
         'SINON' ;            
            A . 'DAT' . icof . 'VALEUR' = valo ;
         'FINSI' ;            
         A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
         A . 'COF' . icof . 'LDAT'   = 'LECT' icof ;
      'FIN' iicof ;         
   'SINON' ;
      ll = 'LECT' ;
   'FINSI' ;
   lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
   'REPETER' iiincq nincq ;
      iincq = &iiincq ;
      iinct = 'MINIMUM' ('LECT' iincq ninct) ;
      A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
      A . 'VAR' . iinct . 'DISC'   = tnomt . 'DISC'  ;
      'SI' lvalt ;
         'SI' lvt ;
            A . 'VAR' . iinct . 'VALEUR'   = 'EXTRAIRE' valt iinct ;
         'SINON' ;
            A . 'VAR' . iinct . 'VALEUR'   = valt ;
         'FINSI' ;            
      'FINSI' ;
      'SI' lcof ;
         icof = 'MINIMUM' ('LECT' iincq ncof) ;
         A . iincq . iinct . 0  = 'LECT' icof ;
      'SINON' ;         
         A . iincq . iinct . 0  = ll ;
      'FINSI' ;         
   'FIN' iiincq ;
*
   'SI' iaxi ;
      numdat = 1 ;
      numcof = dim '+' 1 ;
   'SINON' ;      
      numdat = 0 ;
      numcof = dim ;
   'FINSI' ;      
   numvar = nincq ;
   B = ININLIN numop numvar numdat numcof numder ;
   icof = 0 ;
   'REPETER' iiidim idim ;
      icof = '+' icof 1 ;
      B . 'COF' . icof . 'COMPOR' = 'CHAINE' 'VNOR' &iiidim ;
      B . 'COF' . icof . 'LDAT'   = 'LECT' ;
   'FIN' iiidim ;
*
   'SI' iaxi ;
      icof = '+' icof 1 ;
      B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
      B . 'DAT' . 1 . 'DISC'   = discg ;
      B . 'DAT' . 1 . 'VALEUR' = dprmt ;
      B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
      B . 'COF' . icof . 'LDAT'   = 'LECT' 1 ;
      ll = 'LECT' icof ;
   'SINON' ;
      ll = 'LECT' ;
   'FINSI' ;
   lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
   'REPETER' iiincq nincq ;
      iincq = &iiincq ;
      B . 'VAR' . iincq . 'NOMDDL' = tnomq . 'NOMINC' . iincq ;
      B . 'VAR' . iincq . 'DISC'   = tnomq . 'DISC'  ;
      'SI' lvalq ;
         'SI' lvq ;
            B . 'VAR' . iincq . 'VALEUR'   = 'EXTRAIRE' valq iincq ;
         'SINON' ;
            B . 'VAR' . iincq . 'VALEUR'   = valq ;
         'FINSI' ;            
      'FINSI' ;         
      B . iincq . iincq . 0  = ('LECT' iincq) 'ET' ll ;
   'FIN' iiincq ;
*
   mgnor = NLIN discg _mt A B methgau ;
*
'RESPRO' mgnor ;
'FINPROC' ;
*
* End of procedure file GNOR
*
*ENDPROCEDUR gnor
*BEGINPROCEDUR gvol
************************************************************************
* NOM         : GVOL
* DESCRIPTION :
* Calcule le volume compris dans une surface fermée
* La normale doit être vers l'intérieur pour que le volume soit positif
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011, version initiale
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' GVOL ;
'ARGUMENT' _surf*'MAILLAGE' ;
'ARGUMENT' tdisc*'TABLE' ;
'ARGUMENT' dbg/'LOGIQUE' ;
*
'SI' ('NON' ('EXISTE' dbg)) ;
   dbg = FAUX ;
'FINSI' ;
*
*  Vecteur position et calcul du volume
NOMVIT = @STBL (TDISC . 'XN' . 'NOMINC') ;
DISCG  = TDISC . 'GEOM' . 'DISC' ;
vdim = 'VALEUR' 'DIME' ;
   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
      fdim = 3 ;
   'SINON' ;
      fdim = vdim ;
   'FINSI' ;
   vposc = GETCOO _surf nomvit ;
*   'SI' iaxi ;
*      rs zs = 'COORDONNEE' _surf ;
*      nr = 'EXTRAIRE' nomvit 1 ;
*      nz = 'EXTRAIRE' nomvit 2 ;
*      vposc = 
*   'FINSI' ;
*   fvol = GNOR _surf tdisc 'NPRI' ('CHAINE' discg 'V') 'CPRI' vpos
*                          'NDUA' 'CSTEV' ;
*   rfvol = 'RESULT' fvol ;
*   volx = 'MAXIMUM' ('EXCO' 'UX' rfvol) ;
*   voly = 'MAXIMUM' ('EXCO' 'UY' rfvol) ;
*   vol = '/' ('+' volx voly) vdim ;
   fvolc = GNOR _surf tdisc 'NPRI' discg
                          'NCOF' (chai discg 'V')
                          'CCOF' vposc
                          'NDUA' (chai discg 'V')
                          'FDUA' ('PROG' vdim * 1.) ;
   volc = '/' ('MAXIMUM' ('RESULT' fvolc))
              fdim ;
   vol = volc '*' -1. ;
'RESPRO' vol ;
*
* End of procedure file GVOL
*
'FINPROC' ;
*ENDPROCEDUR gvol
*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 ;
'REPETER' bouc ;
   ok = FAUX ;
   'ARGUMENT' fl/'FLOTTANT' ;
   'ARGUMENT' lr/'LISTREEL' ;
   'ARGUMENT' cp/'CHPOINT ' ;
   'ARGUMENT' cm/'MCHAML  ' ;
   'SI' ('EXISTE' fl) ;
      ok = VRAI ;
      'RESPRO' ('/' ('LOG' fl) ('LOG' 10.D0)) ;
   'FINSI' ;
   'SI' ('EXISTE' lr) ;
      ok = VRAI ;
      'RESPRO' ('/' ('LOG' lr) ('LOG' 10.D0)) ;
   'FINSI' ;
   'SI' ('EXISTE' cp) ;
      ok = VRAI ;
      'RESPRO' ('/' ('LOG' cp) ('LOG' 10.D0)) ;
   'FINSI' ;
   'SI' ('EXISTE' cm) ;
      ok = VRAI ;
      'RESPRO' ('/' ('LOG' cm) ('LOG' 10.D0)) ;
   'FINSI' ;
   'SI' ('NON' ok) ;
      'QUITTER' bouc ;
   'FINSI' ;
'FIN' bouc ;         
*
* End of procedure file LOG10
*
'FINPROC' ;
*ENDPROCEDUR log10
*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 projsysc
************************************************************************
* NOM         : PROJSYSC
* DESCRIPTION : Calcul matrice et second membre projetés suivant
*               un champ de directions données
*
*               Project a linear system with respect to a given
*               vector field
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011, version initiale
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' PROJSYSC ;
'ARGUMENT' tdisc*'TABLE' ;
'ARGUMENT' vnorn*'CHPOINT' ;
'ARGUMENT' ktgra*'RIGIDITE' ;
'ARGUMENT' fpgra*'CHPOINT' ;
'ARGUMENT' kvol/'CHPOINT' ;
lcnt = 'EXISTE' kvol ;
'SI' lcnt ;
   'ARGUMENT' dvol*'FLOTTANT' ;
'FINSI' ;   
vdim = 'VALEUR' 'DIME' ;
NOMVIT = @STBL (TDISC . 'XN' . 'NOMINC') ;
   fpgran = 'PSCAL' fpgra vnorn nomvit nomvit ;
* Condensation de la matrice
*   tknor = 'TABLE' 'ESCLAVE' ;
*   'REPETER' idim vdim ;
*      lnomi = 'EXTRAIRE' nomvit ('LECT' &idim) ;
*      tknor . &idim = 'KOPS' 'MATDIAGO' lnomi
*         ('EXCO' lnomi vnorn lnomi) ;
*   'FIN' idim ;         
*   knord = 'ET' tknor ;
   'SI' lmatrik ;
      knord = 'KOPS' 'MATDIAGO' vnorn 'MATRIK' ;
   'SINON' ;      
      knord = 'KOPS' 'MATDIAGO' vnorn ;
      knord = 'CHANGER' 'INCO' knord nomvit nomvit
         nomfor nomvit  ;
   'FINSI' ;
   'SI' ('EGA' vdim 2) ;
      nomscal = 'MOTS' 'SCAL' 'SCAL' ;
   'SINON' ;      
      nomscal = 'MOTS' 'SCAL' 'SCAL' 'SCAL' ;
   'FINSI' ;      
   knor  = 'CHANGER' 'INCO' knord nomvit nomscal nomvit nomvit  ;
   knort = 'CHANGER' 'INCO' knord nomvit nomvit  nomvit nomscal ;
   'SI' lmatrik ;
      ktgrak = 'KOPS' 'RIMA' ktgra ;
   'SINON' ;
      ktgrak = ktgra ;
   'FINSI' ;      
   ktg1  = 'KOPS' 'CMCT' ktgrak knort ;
   ktg2 = 'KOPS' 'TRANSPOS' ktg1 ;
   ktg3 = 'KOPS' 'CMCT' knort ktg2 ;
   ktot = ktg3 ;
   ftot = fpgran ;
   'SI' lcnt ;
*      'MESSAGE' 'Une contrainte dans projsysc' ;
      ktvol = 'PSCAL' kvol vnorn nomvit nomvit ;
      ktv = rela ('NOMC' 'T' ktvol) ;
      smbvol = 'DEPIMPOSE' ktv dvol ;
      'SI' lmatrik ;
         ktv = 'KOPS' 'RIMA' ktv ;
      'FINSI' ;         
      lpr1 = 'MOTS' 'T' 'LX' ; l2 = 'MOTS' 'SCAL' 'LX' ;
      ldu1 = 'MOTS' 'Q' 'FLX' ;
      ktv = 'CHANGER' 'INCO' ktv lpr1 l2 ldu1 l2 'MULT' ;
      smbvol = 'NOMC' ldu1 l2 smbvol ;
      ktot = ktot 'ET' ktv ;
      ftot = ftot '+' smbvol ;
   'SINON' ;      
*      'MESSAGE' 'Pas de contrainte dans projsysc' ;
   'FINSI' ;      
'RESPRO' ktot ftot ;
*
* End of procedure file PROJSYSC
*
'FINPROC' ;
*ENDPROCEDUR projsysc
*BEGINPROCEDUR quafme
************************************************************************
* NOM         : QUAFME
* DESCRIPTION :
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 01/12/2004, version initiale
* HISTORIQUE : v1, 01/12/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' QUAFME ;
'REPETER' bcl ;
   'ARGUMENT' mquad/'MAILLAGE' ;
   'SI' ('EXISTE' mquad) ;
      mquaf = 'CHANGER' mquad 'QUAF' ;
*      mlin = 'CHANGER' mquad 'LINEAIRE' ;
      'RESPRO' mquaf ;                  
   'SINON' ;
      'QUITTER' bcl ;
   'FINSI' ;
'FIN' bcl ;
'FINPROC' ;         
*
* End of procedure file QUAFME
*
*ENDPROCEDUR quafme
*BEGINPROCEDUR trvec
************************************************************************
* NOM         : TRVEC
* DESCRIPTION : Trace des champs de vecteurs.
*               Utile pour tracer des bilans de forces
*
*               Display vector fields.
*               Useful for visualization of force balance.
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 22/04/2011, version initiale
* HISTORIQUE : v1, 22/04/2011, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
*
'DEBPROC' TRVEC ;
*'ARGUMENT' tdisc*'TABLE' ;
*'ARGUMENT' motdom*'MOT' ;
'ARGUMENT' tdom*'MAILLAGE' ;
*
tvec = 'TABLE' ; ttit = 'TABLE' ;
i = 0 ;
lcoul = 'MOTS' 'JAUN' 'ROUG' 'BLAN' 'TURQ' 'VERT' 'OLIV'
 'AZUR' 'ORAN' 'VIOL' 'GRIS' 'OCEA' ;
*
'REPETER' livec ;
   'SI' ('EGA' i 0) ;
      'ARGUMENT' ccvec*'CHPOINT' ;
   'SINON' ;
      'ARGUMENT' ccvec/'CHPOINT' ;
   'FINSI' ;
   'SI' ('EXISTE' ccvec) ;
      'ARGUMENT' ttvec*'MOT' ;
   'SINON' ;
      'QUITTER' livec ;
   'FINSI' ;
   i = '+' i 1 ;
*   'MESSAGE' ('CHAINE' 'i=' i) ;
*   'LISTE' ccvec ;
*   'LISTE' tvec ;
   tvec . i = ccvec ;
   ttit . i = ttvec ;
'FIN' livec ;
'ARGUMENT' echv/'FLOTTANT' ;
'ARGUMENT' lnclk/'LOGIQUE' ;
'SI' ('NON' ('EXISTE' lnclk)) ;
   lnclk = faux ;
'FINSI' ;   
*
lmax = 'PROG' ;
'REPETER' ii i ;
   mm = 'MAXIMUM' (tvec . &ii) 'ABS' ;
   lmax = 'ET' lmax ('PROG' mm) ;
'FIN' ii ;   
mm = '+' ('MAXIMUM' lmax) 1.D-60 ;
'SI' ('NON' ('EXISTE' echv)) ;
   vmodo = 'EGA' ('VALEUR' 'MODE') 'AXIS' ;
   'SI' vmodo ; 'OPTI' 'MODE' 'PLAN' ; 'FINSI' ;
   ctail = gmass2 ('CHANGER' tdom 'QUAF') tdisc
      'NPRI' 'CSTE' 'FPRI' 1. 'NDUA' 'CSTE' 'FDUA' 1. ;
*   'LISTE' ctail ;      
   'SI' vmodo ; 'OPTI' 'MODE' 'AXIS' ; 'FINSI' ;
   vdim = 'VALEUR' 'DIME' ;
   dimm = DEADUTIL 'DIMM' tdom ;
*   ctail = '**' ctail ('/' 1. ('-' vdim 1)) ;
   ctail = '**' ctail ('/' 1. dimm) ;
   tail = '**' ('*' ('MAXIMUM' ctail) ('MINIMUM' ctail)) 0.5 ;
*'LISTE' tail ;
*'LISTE' mm ;
   echv = '/' ('*' 0.9 tail) mm ;
'FINSI' ;   
tit  = 'CHAINE' 'Max. =' (formar mm 2) ;
*'MESSAGE' ('CHAINE' 'mm=' mm) ;
'REPETER' ii i ;
   cou = EXMOMOD lcoul &ii ;
   tvec . &ii = 'VECT' (tvec . &ii) echv 'DEPL' cou ;
   tit = 'CHAINE' tit ' ' cou '=' (ttit . &ii) ;
'FIN' ii ;   
'SI' lnclk ;
   'TRACER' (@stbl tvec) tdom 'TITR' tit 'NCLK' ;
'SINON' ;
   'TRACER' (@stbl tvec) tdom 'TITR' tit ;
'FINSI' ;
*
* End of procedure file TRVEC
*
'FINPROC' ;
*ENDPROCEDUR trvec
*BEGINPROCEDUR tsurfonc
************************************************************************
* NOM         : TSURFONC
* DESCRIPTION : La fonctionnelle à minimiser pour la tension
*               de surface
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 17/01/2007, version initiale
* HISTORIQUE : v1, 17/01/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 !
************************************************************************
*
*
'DEBPROC' TSURFONC ;
'ARGUMENT' _mt*'MAILLAGE' ;
'ARGUMENT' gdisc*'MOT' ;
'ARGUMENT' methgau*'MOT' ;
*
idim  = 'VALEUR' 'DIME' ;
vdim  = DEADUTIL 'DIMM' _mt ;
*
'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' met/'CHPOINT' ;
*lmet = 'EXISTE' met ;
*'SI' lmet ;
*   debloi = 'CHAINE' 'ADD' ;
*   ncmet  = '/' ('*' idim ('+' idim 1)) 2 ;
*   'ARGUMENT' metdisc*'MOT' ;
**   metdisc = gdisc ;
*'SINON' ;
*   debloi = 'CHAINE' 'ADC' ;
*   ncmet  = 0 ;
*'FINSI' ;   
*loi = 'CHAINE' debloi 'F' ;
'ARGUMENT' optelem/'MOT' ;
*
'SI' ('EXISTE' optelem) ;
   'SI' ('EGA' optelem 'ELEM') ;
      lelem = VRAI ;
   'SINON' ;
      cherr = 'CHAINE' 'Option ' optelem ' inconnue' ;
      'ERREUR' cherr ;
   'FINSI' ;
'SINON' ;
   lelem = FAUX ;            
'FINSI' ;
*
* Calcul de la fonctionnelle
*
numop  = 1 ;
numvar = 1 ;
numder = vdim ;
numdat = 0 ;
numcof = 0 ;
*
   A = ININLIN numop numvar numdat numcof numder ;   
   A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
   A . 'VAR' . 1 . 'DISC'   = 'CSTE' ;
   A . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
*
   numvar = 1 ;
   numdat = 1 ;
   numcof = 1 ;
   B = ININLIN numop numvar numdat numcof numder ;
   B . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
   B . 'VAR' . 1 . 'DISC'   = 'CSTE' ;
   B . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
   B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
   B . 'DAT' . 1 . 'DISC'   = discc ;
   B . 'DAT' . 1 . 'VALEUR' = coef ;
*
   B . 'COF' . 1 . 'COMPOR' = 'TSUF' ;
   B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
*   
   A . 1 . 1 . 0  = 'LECT' ;
   B . 1 . 1 . 0  = 'LECT' 1 ;
*
vfonc = 'NLIN' gdisc _mt A B 'EREF' methgau ;      
*
'SI' ('NON' lelem) ;
   vfonc = 'MAXIMUM' ('RESULT' vfonc) ;
'FINSI' ;   
* 
'RESPRO' vfonc ;
*
* End of procedure file TSURFONC
*
'FINPROC' ;
*ENDPROCEDUR tsurfonc
*BEGINPROCEDUR tsurktan
************************************************************************
* NOM         : TSURKTAN
* DESCRIPTION : La matrice tangente pour la tension de surface
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 17/01/2007, version initiale
* HISTORIQUE : v1, 17/01/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 !
************************************************************************
*
*
'DEBPROC' TSURKTAN ;
'ARGUMENT' _mt*'MAILLAGE' ;
'ARGUMENT' gdisc*'MOT' ;
'ARGUMENT' methgau*'MOT' ;
'ARGUMENT' dppri*'LISTMOTS' ;
'ARGUMENT' dpdua*'LISTMOTS' ;
*
dpdis = gdisc ;
*
idim = 'VALEUR' 'DIME' ;
vdim = DEADUTIL 'DIMM' _mt ;
laxi = DEADUTIL 'AXI?' ;
lsph = DEADUTIL 'SPH?' ;
*
loi = 'CHAINE' 'TSUJ' ;
loij = 'CHAINE' 'TSU' ;
*
'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' jaco/'ENTIER' ;
'SI' ('NON' ('EXISTE' jaco)) ;
   jaco = 1 ;
   dir1 = VRAI ;
'FINSI' ;
'SI' ('OU' ('EGA' jaco 2) ('EGA' jaco 3)) ;
   'ARGUMENT' idir/'ENTIER' ;
   'SI' ('EXISTE' idir) ;
      ldir = 'LECT' idir ;
      'SI' ('EGA' idir 1) ;
         dir1 = VRAI ;
      'FINSI' ;      
   'SINON' ;
      'ARGUMENT' ldir/'LISTENTI' ;
      'SI' ('NON' ('EXISTE' ldir)) ;
         ldir = 'LECT' 1 'PAS' 1 idim ;
         dir1 = VRAI ;
      'FINSI' ;
   'FINSI' ;
'FINSI' ;
'ARGUMENT' lterm/'LISTENTI' ;
llterm = 'EXISTE' lterm ;
'SI' llterm ;
   dlterm = 'DIME' lterm ;
'SINON' ;
   dlterm = 1 ;
'FINSI' ;
*
* Calcul du jacobien complet (jaco = 1)
*
'SI' ('EGA' jaco 1) ;
   numop  = '*' ('**' vdim 2) ('**' idim 2) ;
   numop = '*' numop dlterm ;
   'SI' ('OU' laxi lsph) ;
      numop  = '+' numop ('*' (vdim '*' idim) 2) ;
   'FINSI' ;
   'SI' lsph ;
      numop = '+' numop 1 ;
   'FINSI' ;
   numder = vdim ;
   numvar = idim ;
   numdat = 0 ;
   numcof = 0 ;
*
   A = ININLIN numop numvar numdat numcof numder ;
   numdat = 1 ;
   numcof = numop ;
   B = ININLIN numop numvar numdat numcof numder ;
   'REPETER' ivar numvar ;
      A . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dppri &ivar) ;
      A . 'VAR' . &ivar . 'DISC'   = dpdis ;
      B . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dpdua &ivar) ;
      B . 'VAR' . &ivar . 'DISC'   = dpdis ;
   'FIN' ivar ;      
   iop = 0 ;
   'REPETER' h dlterm ;
      'REPETER' i idim ;
         'REPETER' j vdim ;
            'REPETER' k idim ;
               'REPETER' l vdim ;
                  iop = iop '+' 1 ;
                  A . iop . &i . &j  = 'LECT' ;
                  'SI' llterm ;
                     nl = 'EXTRAIRE' lterm &h ;
                     nomloi = 'CHAINE' loij nl &i &j &k &l ;
                  'SINON' ;
                     nomloi = 'CHAINE' loi &i &j &k &l ;
                  'FINSI' ;                     
*              'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
                  B . 'COF' . iop . 'COMPOR' = nomloi ;
                  B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
                  B . iop . &k . &l  = 'LECT' iop ;
               'FIN' l ;
            'FIN' k ;
         'FIN' j ;
      'FIN' i ;
   'FIN' h ;      
   'SI' ('OU' laxi lsph) ;
      'REPETER' i idim ;
         'REPETER' j vdim ;
            iop = iop '+' 1 ;
            A . iop . &i . &j  = 'LECT' ;
            nomloi = 'CHAINE' loi &i &j '10' ;
*              'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
            B . 'COF' . iop . 'COMPOR' = nomloi ;
            B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
            B . iop . 1 . 0  = 'LECT' iop ;
         'FIN' j ;
      'FIN' i ;
      'REPETER' k idim ;
         'REPETER' l vdim ;
            iop = iop '+' 1 ;
            A . iop . 1 . 0  = 'LECT' ;
            nomloi = 'CHAINE' loi '10' &k &l ;
*              'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
            B . 'COF' . iop . 'COMPOR' = nomloi ;
            B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
            B . iop . &k . &l  = 'LECT' iop ;
         'FIN' l ;
      'FIN' k ;
   'FINSI' ;
   'SI' lsph  ;
      iop = iop '+' 1 ;
      A . iop . 1 . 0  = 'LECT' ;
      nomloi = 'CHAINE' loi '1010' ;
*      'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
      B . 'COF' . iop . 'COMPOR' = nomloi ;
      B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
      B . iop . 1 . 0  = 'LECT' iop ;
   'FINSI' ;
'FINSI' ;   
'SI' ('EGA' jaco 2) ;
   nldir = 'DIME' ldir ;
   numop  = '*' nldir ('**' vdim 2) ;
   'SI' dir1 ;
      'SI' ('OU' laxi lsph) ;
         numop = '+' numop ('*' vdim 2) ;
      'FINSI' ;
      'SI' lsph ;
         numop = '+' numop 1 ;
      'FINSI' ;
   'FINSI' ;                        
*   
   numder = vdim ;
   numvar = idim ;
   numdat = 0 ;
   numcof = 0 ;
*
   A = ININLIN numop numvar numdat numcof numder ;
   numdat = 1 ;
   numcof = numop ;
   B = ININLIN numop numvar numdat numcof numder ;
   'REPETER' ivar numvar ;
      A . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dppri &ivar) ;
      A . 'VAR' . &ivar . 'DISC'   = dpdis ;
      B . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dpdua &ivar) ;
      B . 'VAR' . &ivar . 'DISC'   = dpdis ;
   'FIN' ivar ;      
   iop = 0 ;
   'REPETER' i nldir ;
      idir = 'EXTRAIRE' ldir &i ;
      'REPETER' j vdim ;
         'REPETER' l vdim ;
            iop = iop '+' 1 ;
            A . iop . idir . &j  = 'LECT' ;
            nomloi = 'CHAINE' loi idir &j idir &l ;
*               'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
            B . 'COF' . iop . 'COMPOR' = nomloi ;
            B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
            B . iop . idir . &l  = 'LECT' iop ;
         'FIN' l ;
      'FIN' j ;
   'FIN' i ;
   'SI' dir1 ;
      'SI' ('OU' laxi lsph) ;
         'REPETER' j vdim ;
            iop = iop '+' 1 ;
            A . iop . 1 . &j  = 'LECT' ;
            nomloi = 'CHAINE' loi '1' &j '10' ;
*               'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
            B . 'COF' . iop . 'COMPOR' = nomloi ;
            B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
            B . iop . 1 . 0  = 'LECT' iop ;
         'FIN' j ;
         'REPETER' l vdim ;
            iop = iop '+' 1 ;
            A . iop . 1 . 0 = 'LECT' ;
            nomloi = 'CHAINE' loi '101' &l ;
*               'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
            B . 'COF' . iop . 'COMPOR' = nomloi ;
            B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
            B . iop . 1 . &l  = 'LECT' iop ;
         'FIN' l ;
      'FINSI' ;
      'SI' lsph ;
         iop = iop '+' 1 ;
         A . iop . 1 . 0  = 'LECT' ;
         nomloi = 'CHAINE' loi '1010' ;
*      'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
         B . 'COF' . iop . 'COMPOR' = nomloi ;
         B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
         B . iop . 1 . 0  = 'LECT' iop ;
      'FINSI' ;
   'FINSI' ;
'FINSI' ;
*
'SI' ('EGA' jaco 3) ;
   nldir = 'DIME' ldir ;
*   numop  = '**' vdim 2 ;
   numop  = '*' nldir vdim ;
   'SI' ('ET' dir1 lsph) ;
      numop = '+' numop 1 ;
   'FINSI' ;      
*   
   numder = vdim ;
   numvar = idim ;
   numdat = 0 ;
   numcof = 0 ;
*
   A = ININLIN numop numvar numdat numcof numder ;
   numdat = 1 ;
   numcof = numop ;
   B = ININLIN numop numvar numdat numcof numder ;
   'REPETER' ivar numvar ;
      A . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dppri &ivar) ;
      A . 'VAR' . &ivar . 'DISC'   = dpdis ;
      B . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dpdua &ivar) ;
      B . 'VAR' . &ivar . 'DISC'   = dpdis ;
   'FIN' ivar ;      
   iop = 0 ;
   'REPETER' i nldir ;
      idir = 'EXTRAIRE' ldir &i ;
      'REPETER' j vdim ;
         iop = iop '+' 1 ;
         A . iop . idir . &j  = 'LECT'  ;
         nomloi = 'CHAINE' loi idir &j idir &j ;
*               'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
         B . 'COF' . iop . 'COMPOR' = nomloi ;
         B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
         B . iop . idir . &j  = 'LECT' iop ;
      'FIN' j ;
   'FIN' i ;
   'SI' ('ET' dir1 lsph) ;
      iop = iop '+' 1 ;
      A . iop . 1 . 0  = 'LECT' ;
      nomloi = 'CHAINE' loi '1010' ;
*      'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
      B . 'COF' . iop . 'COMPOR' = nomloi ;
      B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
      B . iop . 1 . 0  = 'LECT' iop ;
   'FINSI' ;      
'FINSI' ;
*
* Partie commune
*   
   B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
   B . 'DAT' . 1 . 'DISC'   = discc ;
   B . 'DAT' . 1 . 'VALEUR' = coef ;
*
jac = 'NLIN' gdisc _mt A B 'EREF' methgau ;
*
'RESPRO' jac ;
*
* End of procedure file TSURKTAN
*
'FINPROC' ;
*ENDPROCEDUR tsurktan
*BEGINPROCEDUR tsurresi
************************************************************************
* NOM         : TSURRESI
* DESCRIPTION : Le résidu à annuler pour la tension de surface
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION    : v1, 17/01/2007, version initiale
* HISTORIQUE : v1, 17/01/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 !
************************************************************************
*
*
'DEBPROC' TSURRESI ;
'ARGUMENT' _mt*'MAILLAGE' ;
'ARGUMENT' gdisc*'MOT' ;
'ARGUMENT' methgau*'MOT' ;
'ARGUMENT' dpdua*'LISTMOTS' ;
*
dpdis = gdisc ;
*
idim  = 'VALEUR' 'DIME' ;
vdim  = DEADUTIL 'DIMM' _mt ;
laxi = DEADUTIL 'AXI?' ;
lsph = DEADUTIL 'SPH?' ;
*
loi = 'CHAINE' 'TSUR' ;
*
'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' ;
*
dir1 = FAUX ;
'ARGUMENT' idir/'ENTIER' ;
'SI' ('EXISTE' idir) ;
   ldir = 'LECT' idir ;
   'SI' ('EGA' idir 1) ;
      dir1 = VRAI ;
   'FINSI' ;      
'SINON' ;
   'ARGUMENT' ldir/'LISTENTI' ;
   'SI' ('NON' ('EXISTE' ldir)) ;
      ldir = 'LECT' 1 'PAS' 1 idim ;
      dir1 = VRAI ;
   'FINSI' ;
'FINSI' ;         
*
* Calcul du résidu
*
nldir = 'DIME' ldir ;
*
numop  = '*' nldir vdim ;
term1 = ('OU' laxi lsph) 'ET' dir1 ;
'SI' term1 ;
   numop = '+' numop 1 ;
'FINSI' ;   
numder = vdim ;
numvar = 1 ;
numdat = 0 ;
numcof = 0 ;
*
   A = ININLIN numop numvar numdat numcof numder ;   
   A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
   A . 'VAR' . 1 . 'DISC'   = 'CSTE' ;
   A . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
*
   numvar = idim ;
   numdat = 1 ;
   numcof = numop ;
   B = ININLIN numop numvar numdat numcof numder ;
   'REPETER' ivar numvar ;
      B . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dpdua &ivar) ;
      B . 'VAR' . &ivar . 'DISC'   = dpdis ;
   'FIN' ivar ;
*   
   B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
   B . 'DAT' . 1 . 'DISC'   = discc ;
   B . 'DAT' . 1 . 'VALEUR' = coef ;
*
   iop = 0 ;
   'REPETER' k nldir ;
      idir = 'EXTRAIRE' ldir &k ;
      'REPETER' l vdim ;
         iop = '+' iop 1 ;   
         A . iop . 1 . 0  = 'LECT' ;
         nomloi = 'CHAINE' loi idir &l ;
*         'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
         B . 'COF' . iop . 'COMPOR' = nomloi ;
         B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
         B . iop . idir . &l  = 'LECT' iop ;
      'FIN' l ;
   'FIN' k ;
*   'LISTE' A ; 'LISTE' iop ;
   'SI' term1 ;
      iop = '+' iop 1 ;
      A . iop . 1 . 0  = 'LECT' ;
      nomloi = 'CHAINE' loi '10' ;
      B . 'COF' . iop . 'COMPOR' = nomloi ;
      B . 'COF' . iop . 'LDAT'   = 'LECT' 1 ;
      B . iop . 1 . 0  = 'LECT' iop ;
   'FINSI' ;      
*
res = 'NLIN' gdisc _mt A B 'EREF' methgau ;      
*
'RESPRO' res ;
*
* End of procedure file TSURRESI
*
'FINPROC' ;
*ENDPROCEDUR tsurresi
**
* COPTCLIM Copy a table with boundary conditions
**
'DEBPROC' COPTCLIM ;
'ARGUMENT' otclim*'TABLE' ;
tclim = 'TABLE' ;
iotclim = index otclim ;
'REPETER' ii ('DIME' iotclim) ;
   indx = iotclim . &ii ;
   tclim . indx = otclim . indx ;
'FIN' ii ;
'RESPRO' tclim ;
'FINPROC' ;
 
**
* DIRDEP
* Procédure créant le champ de direction selon lequel
* les points se déplacent.
* idir = 0 : les points se déplacent suivant la normale à la surface
* idir = 1 : les points se déplacent suivant la direction passant par
*            0. 0.
*
'DEBPROC' DIRDEP ;
'ARGUMENT' _cmt*'MAILLAGE' ;
'ARGUMENT' cmt*'MAILLAGE' ;
'ARGUMENT' sur*'MAILLAGE' ;
'ARGUMENT' tdisc*'TABLE' ;
'ARGUMENT' idir/'ENTIER' ;
'SI' ('NON' ('EXISTE' idir)) ;
   idir = 0 ;
'FINSI' ;   
*
NOMVIT = @STBL (TDISC . 'XN' . 'NOMINC') ;
*
vdim = 'VALEUR' 'DIME' ;
DISCG  = TDISC . 'GEOM' . 'DISC' ;
   'SI' ('EGA' idir 0) ;
      vnor  = GNOR _cmt tdisc 'NPRI' discg 'FPRI' 1. 'NDUA' 'XN' ;
      vnor = '*' vnor -1. ;
      nvnor = '**' ('PSCAL' vnor vnor nomvit nomvit) 0.5 ;
      nvnor = '+' nvnor ('MASQUE' nvnor 'INFERIEUR' 1.D-100) ;
      vnorn = '/' vnor nvnor ;
   'FINSI' ;
   'SI' ('EGA' idir 1) ;
      vnor  = GETCOO cmt nomvit ;
      nvnor = '**' ('PSCAL' vnor vnor nomvit nomvit) 0.5 ;
      nvnor = '+' nvnor ('MASQUE' nvnor 'INFERIEUR' 1.D-100) ;
      vnorn = '/' vnor nvnor ;
   'FINSI' ;
   'SI' ('EGA' idir 2) ;
      vnor1  = GNOR _cmt tdisc 'NPRI' discg 'FPRI' 1. 'NDUA' 'XN' ;
      vnor1 = '*' vnor1 -1. ;
      nvnor1 = '**' ('PSCAL' vnor1 vnor1 nomvit nomvit) 0.5 ;
      nvnor1 = '+' nvnor1 ('MASQUE' nvnor1 'INFERIEUR' 1.D-100) ;
      vnor1n = '/' vnor1 nvnor1 ;
   'FINSI' ;
* Cette formule peut poser problème en axi !
   nvnor = '**' ('PSCAL' vnor vnor nomvit nomvit) 0.5 ;
*  'LISTE' ('MAXIMUM' nvnor) ;
*   'LISTE' ('MINIMUM' nvnor) ;
   nvnor = '+' nvnor ('MASQUE' nvnor 'INFERIEUR' 1.D-100) ;
   vnorn = '/' vnor nvnor ;
*  Correction de vnorn aux points extrémités
   pcmt = 'CHANGER' 'POI1' cmt ;
   mcorr = pB 'ET' pC ;
   vnorn2 = 'MANUEL' 'CHPO' pB ('EXTRAIRE' nomvit 1) 1. ;
   vnorn3 = 'MANUEL' 'CHPO' pC ('EXTRAIRE' nomvit 2) 1. ;
   pmcorr = 'CHANGER' 'POI1' mcorr ;
   pcmtr = 'DIFF' pcmt pmcorr ;
   vnorn1 = 'REDU' vnorn pcmtr ;
   vnorn = vnorn1 '+' vnorn2 '+' vnorn3 ;
'RESPRO' vnorn ;
'FINPROC' ;
**
************************************************************************
*
* 
*   END OF PROCEDURES 
*
*
************************************************************************
************************************************************************
*
* 
*   MAIN : 1) MESH
*          2) COMPUTATIONAL LOOP
*          3) TESTs if interact=FAUX ;
*             GUI   if interact=VRAI ;
*
************************************************************************
*
* Construction du "modèle" (maillage)
* et des paramètres de départ
*
idisc = 'QUAF' ;
'SI' complet ;
   nx = 25 ;
'SINON' ;
   nx = 5 ;
'FINSI' ;   
'SI' interact ;
   critnewt = 2.D-3 ; nitermax = 25 ; omeg = 0.45 ;
'SINON' ;
   critnewt = 1.D-4 ; nitermax = 20 ; omeg = 1.0 ;
'FINSI' ;
methgau = 'GAU7' ;
idir = 1 ;
jacoxf = 3 ; jacoxg = 0 ; jacoxv = 0 ;
jacoxt = 'LECT' 1 2 3 4 ;
*
* Création du maillage
*
   pA = 0. 0. ; pB = 1. 0. ; pC = 0. 1. ;
   bas = 'DROIT' 1 pA pB ; sur = 'CERCLE' nx pB pA pC ;
   gau = 'DROIT' 1 pC pA ;
   cmt = bas 'ET' sur 'ET' gau ;
   tol = 1.D-5 ;
   _bas _sur _gau _cmt = QUAFME bas sur gau cmt ;
   'ELIMINATION' (_bas 'ET' _sur 'ET' _gau 'ET' _cmt) 1.D-5 ;
   'SI' ('EGA' idisc 'QUAF') ; cmt = _cmt ; 'FINSI' ;
*   
************************************************************************
*
* COMPUTATIONAL LOOP
* 
************************************************************************
*
* Bo  : nombre de Bond (gravité / tension de surface)
* ang : angle de la gravité par rapport à la verticale
*
* Structure de la table TCLIM pour les conditions aux limites
*
* En ENTREE :  
*  cvol = vrai => Contrainte sur le volume
*   volv : volume cible
*  cvol = faux 
*   dpv  : différence de pression voulue
*  blocb = VRAI => Contrainte sur la position du point pB
*   rbv : rayon voulu du point B
*  blocb = FAUX
*   abv : angle de contact voulu au point B
*  blocc = VRAI => Contrainte sur la position du point pC
*   rcv : rayon voulu du point C
*  blocc = FAUX
*   acv : angle de contact voulu au point C
* En SORTIE :
*  les mêmes indices sans le v final indiquent
*  les quantités trouvées par le calcul
*
*
'DEBPROC' calcul ;
'ARGUMENT' Bo*'FLOTTANT' ;
'ARGUMENT' ang*'FLOTTANT' ;
'ARGUMENT' tclim*'TABLE' ;
*
vdim = 'VALEUR' 'DIME' ;
vmod = 'VALEUR' 'MODE' ;
*
* Création du "modèle"
*
'SI' ('EGA' vdim 2) ;
   'SI' ('NEG' vmod 'AXIS') ;
      nomvit = 'MOTS' 'UX' 'UY' ;
      nomfor = 'MOTS' 'FX' 'FY' ;
   'SINON' ;      
      nomvit = 'MOTS' 'UR' 'UZ' ;
      nomfor = 'MOTS' 'FR' 'FZ' ;
   'FINSI' ;
'SINON' ;
   nomvit = 'MOTS' 'UX' 'UY' 'UZ' ;
   nomfor = 'MOTS' 'FX' 'FY' 'FZ' ;
'FINSI' ;   
*
nomsca = 'MOTS' 'SCAL' ;
*
TDISC = 'TABLE' ;
TDISC . 'GEOM' = 'TABLE' ;
TDISC . 'GEOM' . 'DISC' = idisc ;
TDISC . 'XN' = 'TABLE' ;
TDISC . 'XN' . 'DISC' = TDISC . 'GEOM' . 'DISC' ;
TDISC . 'XN' . 'NOMINC' = 'TABLE' ;
'REPETER' idim vdim ;
   TDISC . 'XN' . 'NOMINC' . &idim = 'MOTS' ('EXTRAIRE' nomvit &idim) ;
'FIN' idim ;
TDISC . 'FN' = 'TABLE' ;
TDISC . 'FN' . 'DISC' = TDISC . 'GEOM' . 'DISC' ;
TDISC . 'FN' . 'NOMINC' = 'TABLE' ;
'REPETER' idim vdim ;
   TDISC . 'FN' . 'NOMINC' . &idim = 'MOTS' ('EXTRAIRE' nomfor &idim) ;
'FIN' idim ;
lmdisc = 'MOTS' 'CSTE' 'LINE' 'QUAF' ;
'REPETER' iidisc ('DIME' lmdisc) ;
   mdisc = 'EXTRAIRE' lmdisc &iidisc ;
   tdisc . mdisc = 'TABLE' ;
   tdisc . mdisc . 'DISC' = mdisc ;
   tdisc . mdisc . 'NOMINC' = 'TABLE' ;
   tdisc . mdisc . 'NOMINC' . 1 = nomsca ;
   mdiscv = 'CHAINE' mdisc 'V' ;
   tdisc . mdiscv = 'TABLE' ;
   tdisc . mdiscv . 'DISC' = mdisc ;
   tdisc . mdiscv . 'NOMINC' = 'TABLE' ;
   'REPETER' idim vdim ;
      TDISC . mdiscv. 'NOMINC' . &idim =
         'MOTS' ('EXTRAIRE' nomvit &idim) ;
   'FIN' idim ;
'FIN' iidisc ;   
*
DISCG  = TDISC . 'GEOM' . 'DISC' ;
DISCU  = TDISC . 'XN' . 'DISC' ;
NOMVIT = @STBL (TDISC . 'XN' . 'NOMINC') ;
NOMFOR = @STBL (TDISC . 'FN' . 'NOMINC') ;
*
tdisc . 'cmt' = 'TABLE' ;
tdisc . 'cmt' .'QUAF' = _cmt ; tdisc . 'cmt' .'LINE' = cmt ;
tdisc . 'bas' = 'TABLE' ;
tdisc . 'bas' .'QUAF' = _bas ; tdisc . 'bas' .'LINE' = bas ;
tdisc . 'sur' = 'TABLE' ;
tdisc . 'sur' .'QUAF' = _sur ; tdisc . 'sur' .'LINE' = sur ;
tdisc . 'gau' = 'TABLE' ;
tdisc . 'gau' .'QUAF' = _gau ; tdisc . 'gau' .'LINE' = gau ;
*
cmt = tdisc . 'cmt' . discg ;
bas = tdisc . 'bas' . discg ;
gau = tdisc . 'gau' . discg ;
sur = tdisc . 'sur' . discg ;
*
*
lok = vrai ;
lquit = faux ;
*
* Boucle d'itérations (Newton)
*
tclim . 'fini' = 'FORME' ;
vol = GVOL _cmt tdisc faux ;
debug = faux ;
'SI' debug ;
   'MESSAGE' ('CHAINE' 'Volume  initial = ' (formar vol 2)) ;
'FINSI' ;   
'REPETER' it nitermax ;
   tabres = 'TABLE' ;
* Gravité
   fpgra = GGRAVI _cmt tdisc 1. ang ;
   ktgra = GKGRAVI _cmt tdisc jacoxg 1. ang ;
   fpgra = '*' fpgra Bo ;
   ktgra = '*' ktgra Bo ;
   tabres = append tabres 'ftot' fpgra ;
   tabres = append tabres 'ktot' ktgra ;
* Tension de surface
   ftsur = TSURRESI _sur discg methgau nomvit -1. ;
   ktsur = TSURKTAN _sur discg methgau nomvit nomvit +1.
      jacoxt ;
   tabres = append tabres 'ftot' ftsur ;
   tabres = append tabres 'ktot' ktsur ;
* Contrainte éventuelle sur le volume
   'SI' (tclim . 'cvol') ;
      volc = GVOL _cmt tdisc ;
      dvol = ('-' (tclim . 'volv') volc) '*' -1. ;
*   'MESSAGE' ('CHAINE' 'volc=' volc) ;
      'SI' debug ;
         'MESSAGE' ('CHAINE' '-volv volc=' dvol) ;
      'FINSI' ;         
      kvol = GKVOL _cmt tdisc jacoxv ;
      tabres = append tabres 'kcnt' kvol ;
      tabres . 'fcnt' = dvol ;
   'SINON' ;
      fpvol = GNOR _cmt tdisc 'NPRI' 'CSTE'
                              'FPRI' ('*' (tclim . 'dpv') -1.)
                              'NDUA' 'XN' ;
      ktvol = GNORKTAN _cmt tdisc 'NPRI' 'XN' 'NCOF' 'CSTE'
                              'FCOF' ('*' (tclim . 'dpv') +1.)
                              'NDUA' 'XN' ;
      tabres = append tabres 'ftot' fpvol ;
      tabres = append tabres 'ktot' ktvol ;
   'FINSI' ;      
* Conditions aux limites
   'SI' (tclim . 'blob') ;
      rbc = 'COORDONNEE' 1 pB ;
      dr = ('-' (tclim . 'rbv') rbc) '*' +1. ;
      'SI' debug ;
         'MESSAGE' ('CHAINE' '- rbv rbc=' dr) ;
      'FINSI' ;         
      ccl = 'MANUEL' 'CHPO' pB 1 'SCAL' dr ;
      tabres = append tabres 'ccl' ccl ;
   'SINON' ;      
* Force de bord
      delta = tclim . 'abv' ;
      sdel = 'SIN' delta ;
      fborb = TSURRESI _bas discg methgau nomvit ('*' -1. sdel) ;
      kborb = TSURKTAN _bas discg methgau nomvit nomvit ('*' +1. sdel) ;
      tabres = append tabres 'ftot' fborb ;
      tabres = append tabres 'ktot' kborb ;
   'FINSI' ;
* Conditions aux limites
   'SI' (tclim . 'bloc') ;
      rcc = 'COORDONNEE' 2 pC ;
      dr = ('-' (tclim . 'rcv') rcc) '*' +1. ;
      'SI' debug ;
         'MESSAGE' ('CHAINE' '- rcv rcc=' dr) ;
      'FINSI' ;         
      ccl = 'MANUEL' 'CHPO' pC 1 'SCAL' dr ;
      append tabres 'ccl' ccl ;
   'SINON' ;      
* Force de bord
      delta = tclim . 'acv' ;
      sdel = 'SIN' delta ;
      fborc = TSURRESI _gau discg methgau nomvit ('*' -1. sdel) ;
      kborc = TSURKTAN _gau discg methgau nomvit nomvit ('*' +1. sdel) ;
      tabres = append tabres 'ftot' fborc ;
      tabres = append tabres 'ktot' kborc ;
   'FINSI' ;
* Direction du déplacement des points de la surface
   vnor  = GNOR _sur tdisc 'NPRI' discg 'FPRI' 1. 'NDUA' 'XN' ;
   vnorn = DIRDEP _cmt cmt sur tdisc idir ;
*   trvec cmt vnorn 'Vnorn' fpgra 'Fpgra' ftsur 'Ftsur' ;
*      fpvol 'Fpvol' ;
*
* Réduction du système sur l'inconnue déplacement normal
*
   ktg = tabres . 'ktot' ;
*
* Convergence avec backtracking repris sur l'algorithme de
* DEDU ADAP pas parfait...
*
   fback = 2. ; fvdet = 6.D0 ; nback = 10 ; damp = omeg ;
   det0 = DEADJACO _sur discg methgau ;
   'OPTI' 'MODE' plan ;
   mtail = GMASS2 _sur tdisc 'NPRI' discg 'NDUA' discg ;
   'OPTI' 'MODE' vmod ;
   tail = 'KOPS' 'EXTRDIAG' mtail ;
   suri = 'DIFF' ('CHANGER' sur 'POI1') (pB 'ET' pC) ;
   taili = 'REDU' tail suri ;
   dampi = damp ;
   deti  = det0 ;
   backok = FAUX ;
   'REPETER' iback nback ;
     'SI' ('>' &iback 1) ; dampi = '/' dampi fback ; 'FINSI' ;
        'SI' debug ;
           ch = 'CHAINE' '    dampi=' dampi ;
           'MESSAGE' ch ;
         'FINSI' ;           
      ktg2 = '*' ktg ('/' 1. dampi) ;
*      ktg2 = ktg ;
      fpg = tabres . 'ftot' ;
      lcnt = 'EXISTE' tabres 'kcnt' ;
      'SI' lcnt ;
         kvol = tabres . 'kcnt' ;
         dvol = tabres . 'fcnt' ;
         ktotp ftotp = PROJSYSC tdisc vnorn ktg2 fpg kvol dvol ;
      'SINON' ;
         ktotp ftotp = PROJSYSC tdisc vnorn ktg2 fpg ;
      'FINSI' ;
      domb = 'DIFF' ('CHANGER' 'POI1' cmt)
                    ('CHANGER' 'POI1' sur) ;
      ccl = 'MANUEL' 'CHPO' domb 1 'SCAL'  0. ;
      tabres = append tabres 'ccl' ccl ;
      'SI' ('EGA' ('TYPE' ktotp) 'RIGIDITE') ;
         ktotpr = 'KOPS' 'NINCPRDU' ktotp ;
         ftotpr = 'KOPS' 'NINCPRDU' ftotp ;
      'SINON' ;             
         ktotpr = ktotp ;
         ftotpr = ftotp ;
      'FINSI' ;
*      'LISTE' (tabres . 'ccl') ;
      sol   = 'KRES' ktotpr ftotpr 'CLIM' (tabres . 'ccl') ;
*         'LDEPE' FAUX ;
*      sol = '*' sol dampi ;
      dep   = '*' ('EXCO' 'SCAL' sol) vnorn ;
      deps = 'REDU' dep sur ;
      oldconf = 'FORME' ;
      'FORME' deps ;
      depsi = 'REDU' dep suri ;
*      depsi = deps ;
      ndepsi = '**' ('PSCAL' depsi depsi nomvit nomvit) 0.5 ;
      ndr = '/' ndepsi taili ;
      mndr = 'MAXIMUM' ndr ;
      xs ys = 'COORDONNEE' sur ;
      detip = DEADJACO _sur discg methgau ;
      'FORME' oldconf ;
      tyde = 'TYPE' detip ;
      'SI' ('EGA' tyde 'ENTIER') ;
         'SI' debug ;
            ch = 'CHAINE' '    Warning : inv. loc. jacobien !' ;
            'MESSAGE' ch ;
         'FINSI' ;            
      'SINON' ;         
         vardet = ('/' detip deti) ;
         mivd = 'MINIMUM' vardet ;
         mavd = 'MAXIMUM' vardet ;
         mixs = 'MINIMUM' xs ;
         miys = 'MINIMUM' ys ;
         'SI' debug ;
            'MESSAGE' ('CHAINE' 'Maxi dep rel = ' mndr ) ;
            'MESSAGE' ('CHAINE' 'Mini var jaco = ' mivd ) ;
            'MESSAGE' ('CHAINE' 'Maxi var jaco = ' mavd ) ;
            'MESSAGE' ('CHAINE' 'Mini xsurf    = ' mixs ) ;
            'MESSAGE' ('CHAINE' 'Mini ysurf    = ' miys ) ;
         'FINSI' ;            
         bigvar = 'OU' ('>' mavd fvdet) ('<' mivd ('/' 1.D0 fvdet))
            'OU' ('>' mndr ('-' fvdet 1.)) 'OU' ('&lt;EG' mixs -1.D-5)
            'OU' ('&lt;EG' miys -1.D-5) ;
         'SI' bigvar ;
            'SI' debug ;
               ch = 'CHAINE'
               '    Warn : trop grande variation du jaco !' ;
               'MESSAGE' ch ;
            'FINSI' ;                     
         'SINON' ;            
            backok = VRAI ;
            'QUITTER' iback ;
         'FINSI' ;                     
      'FINSI' ;         
   'FIN' iback ;
*
* On peut avoir un problème à la première itération si
* les contraintes ne sont pas vérifiées au départ
*
   'SI' ('ET' ('NON' backok) ('NEG' &it 1)) ;
      chinfo1 = 'CHAINE'
            'Backtracking failed to converge !' ;
      'MESSAGE' chinfo1 ;
      chinfo2 = 'CHAINE' 'Please check the output displacement' ;
      'MESSAGE' chinfo2 ;
*      'SI' ('NEG' &it 1) ;
*         lok = faux ;
*         lquit = vrai ;
*      'FINSI' ;         
   'FINSI' ;
*      
   freac = (ktotpr '*' sol) '-' ftotpr ;
   odep = dep ;
*
* Bilan des forces
*
   fpgrann = '*' ('PSCAL' fpgra vnorn nomvit nomvit) vnorn ;
   ftsurnn = '*' ('PSCAL' ftsur vnorn nomvit nomvit) vnorn ;
   'SI' (tclim . 'cvol') ;
      mulag   = 'EXCO' 'LX' sol 'LX' ;
      fpvolnn = '*' ('*' ktotp ('*' mulag -1.)) vnorn ;
   'SINON' ;
      fpvolnn = '*' ('PSCAL' fpvol vnorn nomvit nomvit) vnorn ;
   'FINSI' ;
   'SI' (tclim . 'blob') ;
      fborbnn = '*' ('REDU' freac pB) vnorn ;
   'SINON' ;
      fborbnn = '*' ('PSCAL' fborb vnorn nomvit nomvit) vnorn ;
   'FINSI' ;
   'SI' (tclim . 'bloc') ;
      fborcnn = '*' ('REDU' freac pC) vnorn ;
   'SINON' ;
      fborcnn = '*' ('PSCAL' fborc vnorn nomvit nomvit) vnorn ;
   'FINSI' ;
* Bilan des forces normales en surface
   desfnn = fpvolnn '+' fpgrann '+' ftsurnn '+' fborbnn '+' fborcnn ;
   fpvolnn = 'REDU' fpvolnn sur ;
   fpgrann = 'REDU' fpgrann sur ;
   ftsurnn = 'REDU' ftsurnn sur ;
   desfnn  = 'REDU' desfnn sur ;
*
   'SI' (tclim . 'cvol') ;
      mulag   = 'EXCO' 'LX' sol 'LX' ;
      tclim . 'dp' = 'MAXIMUM' mulag ;
   'SINON' ;
      tclim . 'dp' = tclim . 'dpv' ;
   'FINSI' ;
*
   maxdepr = 'MAXIMUM' dep 'ABS' ;
   'SI' debug ;
      'MESSAGE' ('CHAINE' 'Maxdepr=' maxdepr)  ;
   'FINSI' ;
         fbornn = fborcnn '+' fborbnn ;
         'SI' graph ;
*         TRVEC sur  fpgrann 'gran' fpvolnn 'voln'
*              ftsurnn 'tsun' fbornn 'born' desfnn 'desn' VRAI ;
         TRVEC cmt dep ('CHAINE' 'Deplacement') 1. VRAI ;
         'FINSI' ;         
   'SI' ('<' maxdepr  critnewt) ;
      lquit = vrai ;
   'FINSI' ;
*   'SI' ('>' maxdepr  ('+' ('ABS' dx) 0.5)) ;
*   'SI' ('>' maxdepr  6.) ;
*      lok = faux ;
*      lquit = vrai ;
*   'FINSI' ;      
*   'OPTION' 'DONN' 5 ;
*  Extension du déplacement sur les points de l'axe et du haut
*  pour les quadratiques !
*
   'SI' lok ;
      'SI' ('EGA' idisc 'QUAF') ;
         'OPTI' 'MODE' 'PLAN' ;
         nomvit2 = 'MOTS' 'UX' 'UY' ;
         nv21 = 'EXTRAIRE' nomvit2 1 ;
         nv22 = 'EXTRAIRE' nomvit2 2 ;
         nv1 = 'EXTRAIRE' nomvit 1 ;
         nv2 = 'EXTRAIRE' nomvit 2 ;
         bux = 'BLOQUE' nv21 gau ;
         buy = 'BLOQUE' nv22 bas ;
         bs  = 'BLOQUE' 'DEPL' sur ;
         fs  = 'DEPIMPOSE' bs ('EXCO' nomvit odep nomvit2) ;
         btot = bux 'ET' buy 'ET' bs ;
         ftot = fs ;
         dx = 'DEDU' adap cmt btot ftot ;
         'OPTI' 'MODE' vmod ;
         dx = 'NOMC' nomvit2 dx  nomvit 'NATURE' 'DIFFUS' ;
         odep = 'CHANGER' 'ATTRIBUT' ('REDU' odep sur)
            'NATURE' 'DIFFUS' ;
*         'LISTE' odep ;
*         'LISTE' dx ;
         odep = odep 'ET' dx ;
      'FINSI' ;
      'FORME' odep ;
* Eventuelle régularisation ?
      'SI' faux ;
      'OPTI' 'MODE' 'PLAN' ;
      nomvit2 = 'MOTS' 'UX' 'UY' ;
      vnor = GNOR _sur tdisc 'NPRI' discg 'FPRI' +1. 'NDUA' 'XN' ;
      vnor = 'NOMC' nomvit nomvit2 vnor ;
      b1 = 'BLOQUE' 'DEPL' 'DIRECTION' vnor sur ;
      b2 = 'BLOQUE' 'DEPL' (pB 'ET' pC) ;
      dx = deduad2 sur (b1 'ET' b2) 'NITM' 1 ;
      'OPTI' 'MODE' vmod ;
      dx = 'NOMC' nomvit2 dx  nomvit 'NATURE' 'DIFFUS' ;
      depsi = 'REDU' dx suri ;
      ndepsi = '**' ('PSCAL' depsi depsi nomvit nomvit) 0.5 ;
      ndr = '/' ndepsi taili ;
      mndr = 'MAXIMUM' ndr ;
      'MESSAGE' ('CHAINE' 'Maxi dep reg rel = ' mndr ) ;
      'SI' ('>' mndr 0.5) ;
         cof = '/' 0.5 mndr ;
         dx = '*' dx cof ;
      'FINSI' ;         
*      trvec sur dx 'dxreg' 1. ;
      'FORME' dx ;
      'FINSI' ;
   'FINSI' ;
* La normale intégrée est nulle sur l'axe avec des quadratiques...
   vmod = 'VALEUR' 'MODE' ;
   'OPTI' 'MODE' 'PLAN' ;
   vnor  = GNOR _sur tdisc 'NPRI' discg 'FPRI' +1. 'NDUA' 'XN' ;
   'OPTI' 'MODE' vmod ;
*   trvec cmt vnor 'VNor' ;
   vnbx  = 'EXTRAIRE' vnor ('EXTRAIRE' nomvit 1) pB ;
   vnby  = 'EXTRAIRE' vnor ('EXTRAIRE' nomvit 2) pB ;
   vnb   = vnbx vnby ;
   fb = 'PVEC' vnb ;
   fbux = 'COORDONNEE' 1 fb ;
   fbuy = 'COORDONNEE' 2 fb ;
*   fbux = 'EXTRAIRE' ftsur ('EXTRAIRE' nomvit 1) pB ;
*   fbuy = 'EXTRAIRE' ftsur ('EXTRAIRE' nomvit 2) pB ;
   fb = fbux fbuy ;
   nfb = '**' ('PSCA' fb fb) 0.5 ;
*   'LISTE' fb ; 'LISTE' nfb ;
   tclim . 'ab' = 'ASIN' ('/' ('*' fbux -1.) nfb) ;
*   tclim . 'ab' = 'ATG' fbux fbuy ;
   vncx  = 'EXTRAIRE' vnor ('EXTRAIRE' nomvit 1) pC ;
   vncy  = 'EXTRAIRE' vnor ('EXTRAIRE' nomvit 2) pC ;
   vnc   = vncx vncy ;
   fc = 'PVEC' vnc ;
   fcux = 'COORDONNEE' 1 fc ;
   fcuy = 'COORDONNEE' 2 fc ;
*   fcux = 'EXTRAIRE' ftsur ('EXTRAIRE' nomvit 1) pC ;
*   fcuy = 'EXTRAIRE' ftsur ('EXTRAIRE' nomvit 2) pC ;
   fc = fcux fcuy ;
   nfc = '**' ('PSCA' fc fc) 0.5 ;
*   'LISTE' fc ; liste nfc ;
   tclim . 'ac' = 'ASIN' ('/' ('*' fcuy +1.) nfc) ;
*   tclim . 'ac' = 'ATG' fcuy fcux ;
   tclim . 'vol' = GVOL _cmt tdisc faux ;   
   tclim . 'rb'  = 'COORDONNEE' 1 pB ;   
   tclim . 'rc'  = 'COORDONNEE' 2 pC ;
*   'LISTE' tclim ;
*   'OPTION' 'DONN' 5 ;
   'SI' lquit ; 'QUITTER' it ; 'FINSI' ;
'FIN' it ;
'SI' ('NON' lquit) ;
   lok = faux ;
'FINSI' ;   
      'SI' (graph 'ET' faux) ;
*         TRVEC cmt dep ('CHAINE' 'Depl omeg=' (formar omeg 1)) 1. ;
         fbornn = fborcnn '+' fborbnn ;
 
         TRVEC sur  fpgrann 'gran' fpvolnn 'voln'
              ftsurnn 'tsun' fbornn 'born' desfnn 'desn' ;
         fpvol = GNOR _cmt tdisc 'NPRI' 'CSTE'
                                 'FPRI' ('*' (tclim . 'dp') -1.)
                                 'NDUA' 'XN' ;
         desf = fpvol '+' fpgra '+' ftsur ;
         suri = 'DIFF' ('CHANGER' sur 'POI1') (pB 'ET' pC) ;
         fpvoli = 'REDU' fpvol suri ;
         fpgrai = 'REDU' fpgra suri ;
         ftsuri = 'REDU' ftsur suri ;
         desfi  = 'REDU' desf  suri ;
         TRVEC sur  fpgrai 'grai' fpvoli 'voli'
              ftsuri 'tsui' desfi 'desi' ;
         TRVEC sur   desfi 'desi' ;
*         'OPTION' 'DONN' 5 ;              
* Bilan des forces en surface
*         fpgrat = '-' fpgra fpgrann ;
*         ftsurt = '-' ftsur ftsurnn ;
*         desft  = fpgrat '+' ftsurt ;
*         psurm = 'DIFF' ('CHANGER' 'POI1' sur) (pB 'ET' pC) ;
*         fpgrat = 'REDU' fpgrat psurm ;
*         ftsurt = 'REDU' ftsurt psurm ;
*         desft  = 'REDU' desft psurm ;
*         TRVEC sur  fpgrat 'grat'
*              ftsurt 'tsut' desft 'dest' ;
*         'OPTION' 'DONN' 5 ;              
      'FINSI' ;
 
'RESPRO' lok ;
'FINPROC' ;
************************************************************************
*
* END OF COMPUTATIONAL LOOP
* 
************************************************************************
*
 
'SI' interact ;
************************************************************************
*
* GUI PART
* 
************************************************************************
tclim = 'TABLE' ;
*
'SI' ('EGA' ('VALEUR' 'MODE') 'AXIS') ;
   tclim . 'cvol' = vrai ; tclim . 'volv' = '*' PI ('/' 2. 3.) ;
'SINON' ;
   tclim . 'cvol' = vrai ; tclim . 'volv' = '/' PI 4. ;
'FINSI' ;
tclim . 'blob' = faux ; tclim . 'abv' = 0. ;
tclim . 'bloc' = faux ; tclim . 'acv' = 0. ;
*
Bo = 1.D-6 ; ang = 0. ;
lok = CALCUL Bo ang tclim ;
*'LISTE' tclim ;
'SI' ('NON' lok) ;
   'MESSAGE' 'Pb: pas detat initial!' ;
'FINSI' ;   
'REPETER' bouc1 ;
   laxi = 'EGA' ('VALEUR' 'MODE') 'AXIS' ;
   'SI' laxi ; tit = 'CHAINE' 'Axi' ;
   'SINON'   ; tit = 'CHAINE' 'Plane' ; 'FINSI' ;
   tit = 'CHAINE' tit ' Bo=' (formar Bo 2) ;
   'SI' ('NON' laxi) ;
   tit = 'CHAINE' tit ' angg='  (formar ang 2) ; 'FINSI' ;
   'SI' (tclim . 'cvol') ;
      tit = 'CHAINE' tit 
         ('CHAINE' ' vol=' (formar (tclim . 'volv') 2)) ;
   'SINON' ;
      tit = 'CHAINE' tit
         ('CHAINE' ' dpv=' (formar (tclim . 'dpv') 2)) ;
   'FINSI' ;         
   'SI' (tclim . 'blob') ;
      tit = 'CHAINE' tit
         ('CHAINE' ' rbv=' (formar (tclim . 'rbv') 2)) ;
   'SINON' ;
      tit = 'CHAINE' tit
         ('CHAINE' ' abv=' (formar (tclim . 'abv') 2)) ;
   'FINSI' ;         
   'SI' (tclim . 'bloc') ;
      tit = 'CHAINE' tit
         ('CHAINE' ' rcv=' (formar (tclim . 'rcv') 2)) ;
   'SINON' ;
      tit = 'CHAINE' tit
         ('CHAINE' ' acv=' (formar (tclim . 'acv') 2)) ;
   'FINSI' ;         
   'TRACER' cmt 'TITR' tit 'NCLK' ;
   omod = 'VALEUR' 'MODE' ;
   oBo = Bo ;
   oang = ang ;
   otclim = coptclim tclim ;
   ofor   = 'FORME' ;
*
* Menu items
* 
   tmenu  = 'TABLE' ; imenu = 0 ;
   tquest = 'TABLE' ;
   imenu = '+' imenu 1 ;
   tmenu . imenu = 'Bond' ;
   tquest . imenu = 'CHAINE' 'Bond number (gravity/surface tension) ? ('
      (formar Bo 2) ')' ;
   'SI' ('NEG' ('VALEUR' 'MODE') 'AXIS') ;
      imenu = '+' imenu 1 ; tmenu . imenu = 'Angg' ;
      tquest . imenu = 'CHAINE'
         'Gravity direction/downward in degrees ? ('
         (formar ang 2) ')' ;
   'FINSI' ;
   imenu = '+' imenu 1 ;
   'SI' (tclim . 'cvol') ;
      tmenu . imenu = 'Volume' ;
      tquest . imenu = 'CHAINE'
         'Prescribed volume ? (' (formar (tclim . 'volv') 2) ')' ;
   'SINON' ;
      tmenu . imenu = 'DeltaP' ;
      tquest . imenu = 'CHAINE'
         'Prescribed pressure difference ? ('
         (formar (tclim . 'dpv') 2) ')' ;
   'FINSI' ;         
   imenu = '+' imenu 1 ;
   'SI' (tclim . 'blob') ;
      tmenu . imenu = 'RadB' ;
      tquest . imenu = 'CHAINE'
         'Prescribed radius at B (lower right) ? ('
         (formar (tclim . 'rbv') 2) ')' ;
   'SINON' ;
      tmenu . imenu = 'AngB' ;
      tquest . imenu = 'CHAINE'
         'Prescribed angle at B (lower right) in degrees ? ('
         (formar (tclim . 'abv') 2) ')' ;
   'FINSI' ;
   'SI' ('NEG' ('VALEUR' 'MODE') 'AXIS') ;
      imenu = '+' imenu 1 ;
      'SI' (tclim . 'bloc') ;
         tmenu . imenu = 'RadC' ;
         tquest . imenu = 'CHAINE'
            'Prescribed radius at C (upper left) ? ('
            (formar (tclim . 'rcv') 2) ')' ;
      'SINON' ;
         tmenu . imenu = 'AngC' ;
         tquest . imenu = 'CHAINE'
            'Prescribed angle at C (upper left) in degrees ? ('
            (formar (tclim . 'acv') 2) ')' ;
      'FINSI' ;
   'FINSI' ;      
   imenu = '+' imenu 1 ; tmenu . imenu = 'Options' ;
*
* Menu display
*
   'SI' ('EGA' imenu 4) ;
      ret = 'MENU' tit (tmenu . 1) (tmenu . 2) (tmenu . 3) (tmenu . 4) ;
   'SINON' ;
      ret = 'MENU' tit (tmenu . 1) (tmenu . 2) (tmenu . 3) (tmenu . 4)
                       (tmenu . 5) (tmenu . 6) ;
   'FINSI' ;
*
* Menu actions
*
   'SI' ('ET' ('NEG' ret 'Quitter') ('NEG' ret 'Options'))   ;
      irep = 0 ;
      'REPETER' ii ('DIME' tmenu) ;
         'SI' ('EGA' ret (tmenu . &ii))  ;
            irep = &ii ;
         'FINSI' ;            
      'FIN' ii ;
      'SI' ('EGA' irep 0) ;
         cherr = 'CHAINE' 'Option ' ret ' unknown' ;
         'ERREUR' cherr ;
      'FINSI' ;
      val = sais ('CHAINE' (tquest . irep) ' : ') 'FLOTTANT' ;
      'SI' ('EGA' ret 'Bond') ; Bo = val ; 'FINSI' ;      
      'SI' ('EGA' ret 'Angg') ; ang = val ; 'FINSI' ;      
      'SI' ('EGA' ret 'Volume') ; tclim . 'volv' = 'ABS' val ; 'FINSI' ;
      'SI' ('EGA' ret 'DeltaP') ; tclim . 'dpv' = val  ; 'FINSI' ;
      'SI' ('EGA' ret 'RadB')   ; tclim . 'rbv' = 'ABS' val  ; 'FINSI' ;
      'SI' ('EGA' ret 'AngB')   ; tclim . 'abv' = val  ; 'FINSI' ;
      'SI' ('EGA' ret 'RadC')   ; tclim . 'rcv' = 'ABS' val  ; 'FINSI' ;
      'SI' ('EGA' ret 'AngC')   ; tclim . 'acv' = val  ; 'FINSI' ;
   'FINSI' ;      
   'SI' ('EGA' ret 'Quitter')   ;
      val = SAIS 'Are you sure you want to quit ? (Y/N)' 'MOT' ;
      'REPETER' bquit ;
         'SI' ('EGA' val 'Y') ; 'QUITTER' bouc1 ; 'FINSI' ;
         'SI' ('EGA' val 'N') ; 'QUITTER' bquit ; 'FINSI' ;
         val = SAIS 'Please answer Yes or No : quit ? (Y/N)' 'MOT' ;
      'FIN' bquit ;
   'FINSI' ;
   'SI' ('EGA' ret 'Options') ;
      axi = 'EGA' ('VALEUR' 'MODE') 'AXIS' ;
      volume = tclim . 'cvol' ;
      radiusb = tclim . 'blob' ;
      radiusc = tclim . 'bloc' ;
      titchoi = 'CHAINE' 'Check options : plane/axi  vol./press. '
        'radius/angle@B  radius/angle@C' ;
      axi volume radiusb radiusc =  'CHOI' titchoi
         axi volume radiusb radiusc ;
      'SI' axi ;
         'OPTI' 'MODE' 'AXIS' ;
         ang = 0 ; radiusc = FAUX ; tclim . 'acv' = 0. ;
      'SINON' ;         
         'OPTI' 'MODE' 'PLAN' ;
      'FINSI' ;
      tclim . 'cvol' = volume ;
      tclim . 'blob' = radiusb ;
      tclim . 'bloc' = radiusc ;
      'SI' volume ;
         'SI' ('NON' ('EXISTE' tclim 'volv')) ;
            tclim . 'volv' = tclim . 'vol' ;
            'OUBLIER' tclim 'dpv' ;
         'FINSI' ;
      'SINON' ;         
         'SI' ('NON' ('EXISTE' tclim 'dpv')) ;
            tclim . 'dpv' = tclim . 'dp' ;
            'OUBLIER' tclim 'volv' ;
         'FINSI' ;
      'FINSI' ;
      'SI' radiusb ;
         'SI' ('NON' ('EXISTE' tclim 'rbv')) ;
            tclim . 'rbv' = tclim . 'rb' ;
            'OUBLIER' tclim 'abv' ;
         'FINSI' ;
      'SINON' ;         
         'SI' ('NON' ('EXISTE' tclim 'abv')) ;
            tclim . 'abv' = tclim . 'ab' ;
            'OUBLIER' tclim 'rbv' ;
         'FINSI' ;
      'FINSI' ;
      'SI' radiusc ;
         'SI' ('NON' ('EXISTE' tclim 'rcv')) ;
            tclim . 'rcv' = tclim . 'rc' ;
            'OUBLIER' tclim 'acv' ;
         'FINSI' ;
      'SINON' ;         
         'SI' ('NON' ('EXISTE' tclim 'acv')) ;
            tclim . 'acv' = tclim . 'ac' ;
            'OUBLIER' tclim 'rcv' ;
         'FINSI' ;
      'FINSI' ;
   'FINSI' ;
*
* New shape
*
   'SI' ('NEG' ret 'Quitter')   ;
      lok = CALCUL Bo ang tclim ;
*      'LISTE' tclim ;
      'SI' ('NON' lok) ;
         'MESSAGE' 'Convergence error !!!' ;
         'OPTI' 'MODE' omod ;
         Bo = oBo ;
         ang = oang ;
         tclim = otclim ;
         'FORME' ofor ;
      'FINSI' ;
   'FINSI' ;      
'FIN' bouc1 ;
************************************************************************
*
* END OF GUI PART
* 
************************************************************************
'FINSI' ;
 
'SI' ('NON' interact) ;
************************************************************************
*
* TEST PART
* 
************************************************************************
lpass = VRAI ;
*
'OPTI' 'MODE' 'PLAN' ;
'SAUTER' 2 'LIGNE' ; 'OPTI' 'ECHO' 1 ;
***
*** Test 1 Plane circular drop, Prescribed contact angle = 90 degrees.
***                             Prescribed volume = 1.
***                             No gravity
***    Test on radius R and pressure difference \delta P
***    2D Laplace-Young's law tells \delta P = \gamma / R.
***    Here \gamma = 1 (non dimensional)
'OPTI' 'ECHO' 0 ;
*
* Computation
*
vol = 1. ;
tclim = 'TABLE' ;
tclim . 'cvol' = vrai ; tclim . 'volv' = vol ;
tclim . 'blob' = faux ; tclim . 'abv' = 0. ;
tclim . 'bloc' = faux ; tclim . 'acv' = 0. ;
Bo = 1.D-6 ; ang = 0. ;
lok = CALCUL Bo ang tclim ;
* list tclim ;
*
* Reference values
*
* V = \frac{\pi R^2}{4}
rref = '**' ('/' ('*' vol 4.) PI) 0.5 ;
dpref = '/' 1. rref ;
*
* Tests
*
rb = tclim . 'rb' ; rc = tclim . 'rc' ; dp = tclim . 'dp' ;
AFFVAR rref 'rref' rb 'rb' rc 'rc' ;
AFFVAR dpref 'dpref' dp 'dp' ;
errv = 2.D-4 ;
err1 = errrel rb rref ; tst1 = '<' err1 errv ;
err2 = errrel rc rref ; tst2 = '<' err2 errv ;
err3 = errrel dp dpref ; tst3 = '<' err3 errv ;
tst = lok 'ET' tst1 'ET' tst2 'ET' tst3 ;
'MESSAGE' ('CHAINE' 'Test 1 : lok  = ' lok)   ;
'MESSAGE' '         err1 = ' err1  ;
'MESSAGE' '         err2 = ' err2  ;
'MESSAGE' '         err3 = ' err3  ;
'SI' tst ;
   'MESSAGE' 'Test 1 OK' ;
'SINON' ;   
   'MESSAGE' '!!! Test 1 not passed  ' ;
'FINSI' ;
*'OPTION' 'DONN' 5 ;
lpass = lpass 'ET' tst ;
'SAUTER' 2 'LIGNE' ; 'OPTI' 'ECHO' 1 ;
***
*** Test 2 Plane circular drop, Prescribed contact angle at B = 70 degrees.
***                             Prescribed volume = 1.
***                             No gravity
***    Test on position of B (xB, 0) and C (0, yC)
***     versus analytical solution
'OPTI' 'ECHO' 0 ;
*
* Computation
*
vol = 1. ; alpha = 20. ; alphar = '*' alpha ('/' PI 180.) ;
tclim = 'TABLE' ;
tclim . 'cvol' = vrai ; tclim . 'volv' = vol ;
tclim . 'blob' = faux ; tclim . 'abv' = -1. '*' alpha ;
tclim . 'bloc' = faux ; tclim . 'acv' = 0. ;
Bo = 1.D-6 ; ang = 0. ;
lok = CALCUL Bo ang tclim ;
*'LISTE' tclim ;
*
* Reference values
*
* V = \frac{R^2}{4} (\pi - 2\alpha - sin 2\alpha) (\alpha in radians)
* xB = R \cos \alpha
* yC = R (1 - \sin \alpha)
dar = '*' alphar 2. ;
da  = '*' alpha 2. ;
rref = '**' ('/' ('*' vol 4.) (PI '-' dar '-' ('SIN' da))) 0.5 ;
xbref = rref '*' ('COS' alpha) ;
ycref = rref '*' ('-' 1. ('SIN' alpha)) ;
*
* Tests
*
xb = tclim . 'rb' ; yc = tclim . 'rc' ;
AFFVAR xbref 'xbref' xb 'xb' ;
AFFVAR ycref 'ycref' yc 'yc' ;
errv = 2.D-4 ;
err1 = errrel xb xbref ; tst1 = '<' err1 errv ;
err2 = errrel yc ycref ; tst2 = '<' err2 errv ;
tst = lok 'ET' tst1 'ET' tst2 ;
'MESSAGE' ('CHAINE' 'Test 2 : lok  = ' lok)   ;
'MESSAGE' '         err1 = ' err1  ;
'MESSAGE' '         err2 = ' err2  ;
'SI' tst ;
   'MESSAGE' 'Test 2 OK' ;
'SINON' ;   
   'MESSAGE' '!!! Test 2 not passed  ' ;
'FINSI' ;
lpass = lpass 'ET' tst ;
'SAUTER' 2 'LIGNE' ; 'OPTI' 'ECHO' 1 ;
***
*** Test 3 Plane drop, Prescribed contact angle at B = 70 degrees.
***                    Prescribed volume = 1.
***                    Bond = -1. (upward gravity)
***    Test on position of C (0, yC)
***     versus numerical solution \cite{sumesh}, figure 2
'OPTI' 'ECHO' 0 ;
*
* Computation
*
vol = 1. ; alpha = 20. ; alphar = '*' alpha ('/' PI 180.) ;
tclim = 'TABLE' ;
tclim . 'cvol' = vrai ; tclim . 'volv' = vol ;
tclim . 'blob' = faux ; tclim . 'abv' = -1. '*' alpha ;
tclim . 'bloc' = faux ; tclim . 'acv' = 0. ;
Bo = -1.D0 ; ang = 0. ;
lok = CALCUL Bo ang tclim ;
*'LISTE' tclim ;
*
* Reference values 
*
ycref = 1.20 ;
*
* Tests
*
yc = tclim . 'rc' ;
AFFVAR ycref 'ycref' yc 'yc' ;
errv = 1.D-2 ;
err1 = errrel yc ycref ; tst1 = '<' err1 errv ;
tst = lok 'ET' tst1 ;
'MESSAGE' ('CHAINE' 'Test 3 : lok  = ' lok)   ;
'MESSAGE' '         err1 = ' err1  ;
'SI' tst ;
   'MESSAGE' 'Test 3 OK' ;
'SINON' ;   
   'MESSAGE' '!!! Test 3 not passed  ' ;
'FINSI' ;
lpass = lpass 'ET' tst ;
'OPTI' 'MODE' 'AXIS' ;
'SAUTER' 2 'LIGNE' ; 'OPTI' 'ECHO' 1 ;
***
*** Test 4 Axisymmetric spherical drop,
***                             Prescribed contact angle = 90 degrees.
***                             Prescribed pressure difference
***                               such that volume= 3 PI / 2
***                             No gravity
***    Test on radius at B and C and volume V 
***    3D Laplace-Young's law tells \delta P = 2 \gamma / R.
***    Here \gamma = 1 (non dimensional)
'OPTI' 'ECHO' 0 ;
*
* Computation
*
volref = '/' ('*' PI 3.) 2. ;
*
* Reference values
*
* V = \frac{2 \pi R^3}{3}
rref = '**' ('/' ('*' volref 3.) ('*' 2. PI)) ('/' 1. 3.) ;
dpref = '/' 2. rref ;
*
tclim = 'TABLE' ;
tclim . 'cvol' = faux ; tclim . 'dpv' = dpref ;
tclim . 'blob' = faux ; tclim . 'abv' = 0. ;
tclim . 'bloc' = faux ; tclim . 'acv' = 0. ;
Bo = 1.D-6 ; ang = 0. ;
lok = CALCUL Bo ang tclim ;
*'LISTE' tclim ;
*
* Tests
*
rb = tclim . 'rb' ; rc = tclim . 'rc' ; vol = tclim . 'vol' ;
AFFVAR rref 'rref' rb 'rb' rc 'rc' ;
AFFVAR volref 'volref' vol 'vol' ;
errv = 2.D-4 ;
err1 = errrel rb rref ; tst1 = '<' err1 errv ;
err2 = errrel rc rref ; tst2 = '<' err2 errv ;
err3 = errrel vol volref ; tst3 = '<' err3 errv ;
tst = lok 'ET' tst1 'ET' tst2 'ET' tst3 ;
'MESSAGE' ('CHAINE' 'Test 4 : lok  = ' lok)   ;
'MESSAGE' '         err1 = ' err1  ;
'MESSAGE' '         err2 = ' err2  ;
'MESSAGE' '         err3 = ' err3  ;
'SI' tst ;
   'MESSAGE' 'Test 4 OK' ;
'SINON' ;   
   'MESSAGE' '!!! Test 4 not passed  ' ;
'FINSI' ;
lpass = lpass 'ET' tst ;
'SAUTER' 2 'LIGNE' ; 'OPTI' 'ECHO' 1 ;
***
*** Test 5 Axisymmetric spherical drop,
***                             Prescribed contact angle at B = 50 degrees.
***                             Prescribed volume = 3 PI / 2
***                             No gravity
***    Test on position of B (xB, 0) and C (0, yC)
***     versus analytical solution 
'OPTI' 'ECHO' 0 ;
*
* Computation
*
vol = '/' ('*' PI 3.) 2. ; alpha = 40. ;
tclim = 'TABLE' ;
tclim . 'cvol' = vrai ; tclim . 'volv' = vol ;
tclim . 'blob' = faux ; tclim . 'abv' = -1. '*' alpha ;
tclim . 'bloc' = faux ; tclim . 'acv' = 0. ;
Bo = 1.D-6 ; ang = 0. ;
lok = CALCUL Bo ang tclim ;
*'LISTE' tclim ;
*
* Reference values
*
* V = \pi \frac{R^3}{3} (1 - sin \alpha)^2  (2 + sin \alpha)
* rB = R \cos \alpha
* zC = R (1 - \sin \alpha)
rref = '**' ('/' ('*' vol 3.) (PI
                               '*' ('**' ('-' 1. ('SIN' alpha)) 2.)
                               '*' ('+' 2. ('SIN' alpha)))
                               ) ('/' 1. 3.) ;
rbref = rref '*' ('COS' alpha) ;
zcref = rref '*' ('-' 1. ('SIN' alpha)) ;
*
* Tests
*
rb = tclim . 'rb' ; zc = tclim . 'rc' ;
AFFVAR rbref 'rbref' rb 'rb' ;
AFFVAR zcref 'zcref' zc 'zc' ;
errv = 2.D-4 ;
err1 = errrel rb rbref ; tst1 = '<' err1 errv ;
err2 = errrel zc zcref ; tst2 = '<' err2 errv ;
tst = lok 'ET' tst1 'ET' tst2 ;
'MESSAGE' ('CHAINE' 'Test 5 : lok  = ' lok)   ;
'MESSAGE' '         err1 = ' err1  ;
'MESSAGE' '         err2 = ' err2  ;
'SI' tst ;
   'MESSAGE' 'Test 5 OK' ;
'SINON' ;   
   'MESSAGE' '!!! Test 5 not passed  ' ;
'FINSI' ;
lpass = lpass 'ET' tst ;
'SAUTER' 2 'LIGNE' ; 'OPTI' 'ECHO' 1 ;
***
*** Test 6 Axisymmetric drop, Prescribed contact angle at B = 50 degrees.
***                           Prescribed volume = 3 PI / 2
***                           Bond = -1. (upward gravity)
***    Test on position of C (0, zC)
***     versus numerical solution \cite{sumesh}, figure 8
'OPTI' 'ECHO' 0 ;
*
* Computation
*
vol = '/' ('*' PI 3.) 2. ; alpha = 40. ;
tclim = 'TABLE' ;
tclim . 'cvol' = vrai ; tclim . 'volv' = vol ;
tclim . 'blob' = faux ; tclim . 'abv' = -1. '*' alpha ;
tclim . 'bloc' = faux ; tclim . 'acv' = 0. ;
Bo = -1.D0 ; ang = 0. ;
lok = CALCUL Bo ang tclim ;
*'LISTE' tclim ;
*
* Reference values 
*
*zcref = 0.90 ;
zcref = 1.094 ;
*
* Tests
*
zc = tclim . 'rc' ;
AFFVAR zcref 'zcref' zc 'zc' ;
errv = 1.D-2 ;
err1 = errrel zc zcref ; tst1 = '<' err1 errv ;
tst = lok 'ET' tst1 ;
'MESSAGE' ('CHAINE' 'Test 6 : lok  = ' lok)   ;
'MESSAGE' '         err1 = ' err1  ;
'SI' tst ;
   'MESSAGE' 'Test 6 OK' ;
'SINON' ;   
   'MESSAGE' '!!! Test 6 not passed  ' ;
'FINSI' ;
lpass = lpass 'ET' tst ;
 
 
 
'SAUTER' 2 'LIGNE' ;
'SI' lpass ;
   'MESSAGE' 'Tout sest bien passe' ;
'SINON' ;
   'MESSAGE' 'Il y a eu des erreurs' ;
'FINSI' ;   
'SAUTER' 2 'LIGNE' ;
'SI' ('NON' lpass) ;
   'ERREUR' 5 ;
'FINSI' ;   
************************************************************************
*
* END OF TEST PART
* 
************************************************************************
'FINSI' ;
'SI' interact ;
   'OPTION' 'DONN' 5 'ECHO' 1 ;
'FINSI' ;   
*
 'FIN' ;