* 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 0 ;
'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 0 ;
'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 0 ;
'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 0 ;
'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' ('<EG' mixs -1.D-5)
'OU' ('<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' ;
© Cast3M 2003 - All rights reserved.
Disclaimer