* fichier : trj_regu.dgibi
'OPTION' 'ECHO' 0 ;
************************************************************************
* NOM : TRJ_REGU
* DESCRIPTION : Test élémentaire Résidu et Jacobien pour méthode de
* régularisation de maillage en toute dimension d'espace
* (opérateur 'DEDU' option 'ADAP')
*
*
* LANGAGE : GIBIANE-CAST3M
* AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
* mél : gounand@semt2.smts.cea.fr
**********************************************************************
* VERSION : v1, 20/12/2005, version initiale
* HISTORIQUE : v1, 20/12/2005, 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 ;
*
'REPETER' desp 3 ;
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' ;
*
* Test du résidu
*
res = DEADRESI _mt gdisc methgau theta gamma incod ;
* 'LISTE' res ;
Ephi = DEADFONC _mt gdisc methgau theta gamma ;
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 ;
'FORME' dpsi ;
Ephidpsi = DEADFONC _mt gdisc methgau theta gamma ;
'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) ;
'SI' interact ;
cherr = 'CHAINE' '!!!! erro=' erro ;
'ERREUR' cherr ;
'SINON' ;
'ERREUR' 5 ;
'FINSI' ;
'FINSI' ;
'FIN' idim ;
*'FIN' desp ;
*'OPTION' 'ECHO' 1 ;
*
* Test du jacobien (par morceaux)
*
* jac = jacob tabmod 'TEST' ;
jac = DEADKTAN _mt gdisc methgau theta gamma incop incod ;
* 'LISTE' jac ;
* resunp = RESID tabmod 'TEST' ;
resunp = DEADRESI _mt gdisc methgau theta gamma incod ;
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 'TEST' ;
resper = DEADRESI _mt gdisc methgau theta gamma incod ;
'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) ;
'SI' interact ;
cherr = 'CHAINE' '!!!! erro=' erro ;
'ERREUR' cherr ;
'SINON' ;
'ERREUR' 5 ;
'FINSI' ;
'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_REGU
*
'FIN' ;
© Cast3M 2003 - All rights reserved.
Disclaimer