* fichier : trj_met.dgibi
************************************************************************
* NOM : TRJ_MET
* DESCRIPTION : Test élémentaire Résidu et Jacobien avec métrique
* pour 'DEDU' 'ADAP'
*
*
* LANGAGE : GIBIANE-CAST3M
* AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
* mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION : v1, 21/03/2006, version initiale
* HISTORIQUE : v1, 21/03/2006, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
* Prière de PRENDRE LE TEMPS de compléter les commentaires
* en cas de modification de ce sous-programme afin de faciliter
* la maintenance !
************************************************************************
*
*
interact= FAUX ;
*
*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
*
eps = 1.D-8 ;
eps2 = '**' eps 0.5D0 ;
theta = 0.2D0 ; gamma = 2.D0 ;
*
dmax = 3 ;
*
'REPETER' desp dmax ;
dimesp = &desp ;
'MESSAGE' ('CHAINE' 'Dim. esp. = ' dimesp) ;
'OPTION' 'DIME' dimesp ;
*
* Maillage
*
'REPETER' dmail dimesp ;
dimmail = &dmail ;
'MESSAGE' ('CHAINE' 'Dim. mail. = ' dimmail) ;
'SI' ('EGA' dimmail 1) ;
'OPTION' 'ELEM' 'SEG2' ;
c1 = '**' 2 0.5D0 ;
c2 = PI ;
lA = 'PROG' c1 c2 c1 ;
lB = 'PROG' c2 c1 c2 ;
pA = 'POIN' lA ; pB = 'POIN' lB ;
mt = 'DROIT' 1 pA pB ;
'FINSI' ;
'SI' ('EGA' dimmail 2) ;
'OPTION' 'ELEM' 'TRI3' ;
c1 = '**' 2 0.5D0 ;
c2 = PI ;
c3 = PI '*' PI ;
lA = 'PROG' c1 c1 c2 ;
lB = 'PROG' c2 c3 c3 ;
lC = 'PROG' c3 c3 c3 ;
pA = 'POIN' lA ; pB = 'POIN' lB ;
pC = 'POIN' lC ;
mt = 'MANUEL' 'TRI3' pA pB pC ;
'FINSI' ;
'SI' ('EGA' dimmail 3) ;
'OPTION' 'ELEM' 'TET4' ;
c1 = '**' 2 0.5D0 ;
c2 = PI ;
c3 = PI '*' PI ;
c4 = PI '*' PI '*' c1 ;
c5 = '+' 1.D0 c3 ;
pA = ('+' c1 c5) c1 ('*' c1 -1.D0) ;
pB = ('+' c2 c5) c3 c2 ;
pC = ('+' ('*' c3 -1.D0) c5) c2 c3 ;
pD = ('+' c4 c5) ('*' c4 -1.D0) c4 ;
mt = 'MANUEL' 'TET4' pA pB pC pD ;
'FINSI' ;
*
_mt = 'CHANGER' mt 'QUAF' ;
*
* Inconnus et discrétisation
*
methgau = 'GAU7' ;
gdisc = 'LINE' ;
lcmpp = 'MOTS' 'UX' 'UY' 'UZ' ;
lcmpd = 'MOTS' 'FX' 'FY' 'FZ' ;
lext = 'LECT' 1 PAS 1 dimesp ;
*
incop = 'EXTRAIRE' lcmpp lext ;
incod = 'EXTRAIRE' lcmpd lext ;
*
vdim = 'VALEUR' 'DIME' ;
*
'SI' ('EGA' dimesp 1) ;
lcmp = 'MOTS' 'G11' ;
lval = 'PROG' 2.D0 ;
'FINSI' ;
'SI' ('EGA' dimesp 2) ;
lcmp = 'MOTS' 'G11' 'G22' 'G12' ;
lval = 'PROG' 2.D0 3.D0 0.47D0 ;
'FINSI' ;
'SI' ('EGA' dimesp 3) ;
lcmp = 'MOTS' 'G11' 'G22' 'G33' 'G12' 'G13' 'G23' ;
lval = 'PROG' 2.D0 3.D0 4.D0 0.47D0 0.53D0 0.5D0 ;
'FINSI' ;
met = 'MANUEL' 'CHPO' mt lcmp lval ;
*
* Test du résidu
*
res = DEADRESI _mt gdisc methgau theta gamma incod met gdisc ;
'LISTE' res ;
Ephi = DEADFONC _mt gdisc methgau theta gamma met gdisc ;
unpert = 'FORME' ;
*
'OPTION' 'ECHO' 0 ;
'REPETER' idim vdim ;
iidim = &idim ;
po = pA ;
incoip = 'EXTRAIRE' incop iidim ;
incoid = 'EXTRAIRE' incod iidim ;
dpsi = 'MANUEL' 'CHPO' po 1 incoip eps ;
* 'LISTE' dpsi ;
'FORME' dpsi ;
Ephidpsi = DEADFONC _mt gdisc methgau theta gamma met gdisc ;
'FORME' unpert ;
resiapp = '/' ('-' Ephidpsi Ephi) eps ;
resical = 'EXTRAIRE' res incoid po ;
erro = ERRREL resical resiapp ;
'MESSAGE' ('CHAINE' ' Composante ' incoid) ;
'MESSAGE' ('CHAINE' ' resiapp=' resiapp) ;
'MESSAGE' ('CHAINE' ' resical=' resical) ;
'MESSAGE' ('CHAINE' ' erro=' erro) ;
'SI' ('>' erro eps2) ;
cherr = 'CHAINE' '!!!! erro=' erro ;
'ERREUR' cherr ;
'FINSI' ;
'FIN' idim ;
*'OPTION' 'DONN' 5 ;
*
*
* 'FIN' dmail ;
*'FIN' desp ;
*'OPTION' 'ECHO' 1 ;
*'OPTION' 'DONN' 5 ;
*
* Test du jacobien (par morceaux)
*
* jac = jacob tabmod met 'TEST' ;
jac = DEADKTAN _mt gdisc methgau theta gamma incop incod
met gdisc ;
* 'LISTE' jac ;
* resunp = RESID tabmod met 'TEST';
resunp = DEADRESI _mt gdisc methgau theta gamma incod met gdisc ;
unpert = 'FORME' ;
'REPETER' idim vdim ;
iidim = &idim ;
ppert = pA ;
incoip = 'EXTRAIRE' incop iidim ;
incoid = 'EXTRAIRE' incod iidim ;
dpsi = 'MANUEL' 'CHPO' ppert 1 incoip eps ;
'FORME' dpsi ;
* resper = RESID tabmod met 'TEST' ;
* resper = RESID tabmod met tyfonc ;
resper = DEADRESI _mt gdisc methgau theta gamma incod
met gdisc ;
'FORME' unpert ;
dresapp = '/' ('-' resper resunp) eps ;
dpert = 'MANUEL' 'CHPO' ppert 1 incoip 1.D0 ;
drescal = '*' jac dpert ;
erro = '/' ('**' ('XTX' ('-' drescal dresapp)) 0.5D0)
('**' ('XTX' drescal) 0.5D0) ;
'MESSAGE' ('CHAINE' ' Composante ' incoip) ;
'MESSAGE' ('CHAINE' ' dresapp=') ; 'LISTE' dresapp ;
'MESSAGE' ('CHAINE' ' drescal=') ; 'LISTE' drescal ;
'MESSAGE' ('CHAINE' ' erro=' erro) ;
'SI' ('>' erro eps2) ;
cherr = 'CHAINE' '!!!! erro=' erro ;
'ERREUR' cherr ;
'FINSI' ;
'FIN' idim ;
'FIN' dmail ;
'FIN' desp ;
'SAUTER' 2 'LIGNE' ;
'MESSAGE' ('CHAINE' 'Tout sest bien passe !') ;
'SAUTER' 2 'LIGNE' ;
'OPTION' 'ECHO' 1 ;
*
'SI' interact ;
'OPTION' 'ECHO' 1 ;
'OPTION' 'DONN' 5 ;
'FINSI' ;
*
* End of dgibi file TRJ_MET
*
'FIN' ;
© Cast3M 2003 - All rights reserved.
Disclaimer