Télécharger la plaquette Cast3M


fr en

Télécharger trj_regu.dgibi

Retour à la liste

Numérotation des lignes : 

  1. * fichier : trj_regu.dgibi
  2. ************************************************************************
  3. ************************************************************************
  4. 'OPTION' 'ECHO' 1 ; 
  5. ************************************************************************
  6. * NOM         : TRJ_REGU
  7. * DESCRIPTION : Test élémentaire Résidu et Jacobien pour méthode de
  8. *               régularisation de maillage en toute dimension d'espace
  9. *               (opérateur 'DEDU' option 'ADAP')
  10. *
  11. *
  12. * LANGAGE     : GIBIANE-CAST3M
  13. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14. *               mél : gounand@semt2.smts.cea.fr
  15. **********************************************************************
  16. * VERSION    : v1, 20/12/2005, version initiale
  17. * HISTORIQUE : v1, 20/12/2005, création
  18. * HISTORIQUE :
  19. * HISTORIQUE :
  20. ************************************************************************
  21. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  22. * en cas de modification de ce sous-programme afin de faciliter
  23. * la maintenance !
  24. ************************************************************************
  25. *
  26. *
  27. interact= FAUX ;
  28. *
  29. *BEGINPROCEDUR errrel
  30. ************************************************************************
  31. * NOM         : ERRREL
  32. * DESCRIPTION : Calcul d'une erreur relative
  33. *
  34. *
  35. *
  36. * LANGAGE     : GIBIANE-CAST3M
  37. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  38. *               mél : gounand@semt2.smts.cea.fr
  39. **********************************************************************
  40. * VERSION    : v1, 23/04/2003, version initiale
  41. * HISTORIQUE : v1, 23/04/2003, création
  42. * HISTORIQUE :
  43. * HISTORIQUE :
  44. ************************************************************************
  45. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  46. * en cas de modification de ce sous-programme afin de faciliter
  47. * la maintenance !
  48. ************************************************************************
  49. *
  50. *
  51. 'DEBPROC' ERRREL ;
  52. 'ARGUMENT' val*'FLOTTANT' ;
  53. 'ARGUMENT' valref*'FLOTTANT' ;
  54. *
  55. 'SI' ('<' ('ABS' valref) 1.D-10) ;
  56.    echref = 1.D0 ;
  57. 'SINON' ;
  58.    echref = valref ;   
  59. 'FINSI' ;
  60. *
  61. errabs = 'ABS' ('/' ('-' val valref) echref);
  62. *
  63. 'RESPRO' errabs ;
  64. *
  65. * End of procedure file ERRREL
  66. *
  67. 'FINPROC' ;
  68. *ENDPROCEDUR errrel
  69. *
  70. eps = 1.D-8 ;
  71. eps2 = '**' eps 0.5D0 ;
  72. theta = 0.2D0 ; gamma = 2.D0 ;
  73. *
  74. 'REPETER' desp 3 ;
  75.    dimesp = &desp ;
  76.    'MESSAGE' ('CHAINE' 'Dim. esp. = ' dimesp) ;
  77.    'OPTION' 'DIME' dimesp ;
  78. *
  79. * Maillage
  80. *
  81.    'REPETER' dmail dimesp ;
  82.       dimmail = &dmail ;
  83.       'MESSAGE' ('CHAINE' 'Dim. mail. = ' dimmail) ;
  84.       'SI' ('EGA' dimmail 1) ;
  85.          'OPTION' 'ELEM' 'SEG2' ;
  86.          c1 = '**' 2 0.5D0 ;
  87.          c2 = PI ;
  88. *         lA = 'PROG' c1 c2 c1 ;
  89. *         lB = 'PROG' c2 c1 c2 ;
  90.          SI ((VALE DIME) EGA 1);
  91.            pA = 'POIN' c1 ;
  92.            pB = 'POIN' c2 ;
  93.          FINSI;
  94.          SI ((VALE DIME) EGA 2);
  95.            pA = 'POIN' c1 c2 ;
  96.            pB = 'POIN' c2 c1 ;
  97.          FINSI;
  98.          SI ((VALE DIME) EGA 3);
  99.            pA = 'POIN' c1 c2 c1 ;
  100.            pB = 'POIN' c2 c1 c2 ;
  101.          FINSI;
  102.          mt = 'DROIT' 1 pA pB ;
  103.       'FINSI' ;
  104.       'SI' ('EGA' dimmail 2) ;
  105.          'OPTION' 'ELEM' 'TRI3' ;
  106.          c1 = '**' 2 0.5D0 ;
  107.          c2 = PI ;
  108.          c3 = PI '*' PI ;
  109. *         lA = 'PROG' c1 c1 c2 ;
  110. *         lB = 'PROG' c2 c3 c3 ;
  111. *         lC = 'PROG' c3 c3 c3 ;
  112.          SI ((VALE DIME) EGA 1);
  113.            pA = 'POIN' c1 ;
  114.            pB = 'POIN' c2 ;
  115.            pC = 'POIN' c3 ;
  116.          FINSI;
  117.          SI ((VALE DIME) EGA 2);
  118.            pA = 'POIN' c1 c1 ;
  119.            pB = 'POIN' c2 c3 ;
  120.            pC = 'POIN' c3 c3 ;
  121.          FINSI;
  122.          SI ((VALE DIME) EGA 3);
  123.            pA = 'POIN' c1 c1 c2 ;
  124.            pB = 'POIN' c2 c3 c3 ;
  125.            pC = 'POIN' c3 c3 c3 ;
  126.          FINSI;
  127.          mt = 'MANUEL' 'TRI3' pA pB pC ;
  128.       'FINSI' ;         
  129.       'SI' ('EGA' dimmail 3) ;
  130.          'OPTION' 'ELEM' 'TET4' ;
  131.          c1 = '**' 2 0.5D0 ;
  132.          c2 = PI ;
  133.          c3 = PI '*' PI ;
  134.          c4 = PI '*' PI '*' c1 ;
  135.          c5 = '+' 1.D0 c3 ;
  136.          pA = ('+' c1 c5) c1 ('*' c1 -1.D0) ;
  137.          pB = ('+' c2 c5) c3 c2 ;
  138.          pC = ('+' ('*' c3 -1.D0) c5) c2 c3 ;
  139.          pD = ('+' c4 c5) ('*' c4 -1.D0) c4 ;
  140.          mt = 'MANUEL' 'TET4' pA pB pC pD ;
  141.       'FINSI' ;         
  142. *
  143.       _mt = 'CHANGER' mt 'QUAF' ;
  144. *
  145. * Inconnus et discrétisation
  146. *
  147.       methgau = 'GAU7' ;
  148.       gdisc   = 'LINE' ;
  149.       lcmpp = 'MOTS' 'UX' 'UY' 'UZ' ;
  150.       lcmpd = 'MOTS' 'FX' 'FY' 'FZ' ;
  151.       lext = 'LECT' 1 PAS 1 dimesp ;
  152. *   
  153.       incop = 'EXTRAIRE' lcmpp lext ;
  154.       incod = 'EXTRAIRE' lcmpd lext ;
  155. *
  156.       vdim  = 'VALEUR' 'DIME' ;
  157. *
  158. * Test du résidu 
  159. *
  160.       res = DEADRESI _mt gdisc methgau theta gamma incod ;
  161. *      'LISTE' res ;
  162.       Ephi = DEADFONC _mt gdisc methgau theta gamma ;
  163.       unpert = 'FORME' ;
  164. *
  165.       'OPTION' 'ECHO' 0 ;
  166.       'REPETER' idim vdim ;
  167.          iidim = &idim ;
  168.          po = pA ;
  169.          incoip = 'EXTRAIRE' incop iidim ;
  170.          incoid = 'EXTRAIRE' incod iidim ;
  171.          dpsi = 'MANUEL' 'CHPO' po 1 incoip eps ;
  172.          'FORME' dpsi ;
  173.          Ephidpsi = DEADFONC _mt gdisc methgau theta gamma ;
  174.          'FORME' unpert ;
  175.          resiapp = '/' ('-' Ephidpsi Ephi) eps ;
  176.          resical = 'EXTRAIRE' res incoid po ;
  177.          erro = ERRREL resical resiapp ;
  178.          'MESSAGE' ('CHAINE' '   Composante ' incoid) ;
  179.          'MESSAGE' ('CHAINE' '   resiapp=' resiapp) ;
  180.          'MESSAGE' ('CHAINE' '   resical=' resical) ;
  181.          'MESSAGE' ('CHAINE' '   erro=' erro) ;
  182.          'SI' ('>' erro eps2) ;
  183.             'SI' interact ;
  184.                cherr = 'CHAINE' '!!!! erro=' erro ;
  185.                'ERREUR' cherr ;
  186.             'SINON' ;
  187.                'ERREUR' 5 ;
  188.             'FINSI' ;                                 
  189.          'FINSI' ;
  190.       'FIN' idim ;
  191. *'FIN' desp ;
  192. *'OPTION' 'ECHO' 1 ;
  193.  
  194. *
  195. * Test du jacobien (par morceaux)
  196. *
  197. *   jac = jacob tabmod  'TEST' ;
  198.       jac = DEADKTAN _mt gdisc methgau theta gamma incop incod ;
  199. *      'LISTE' jac ;
  200. *   resunp = RESID tabmod 'TEST' ;
  201.       resunp =  DEADRESI _mt gdisc methgau theta gamma incod ;
  202.       unpert = 'FORME' ;
  203.       'REPETER' idim vdim ;
  204.          iidim = &idim ;
  205.          ppert = pA ;
  206.          incoip = 'EXTRAIRE' incop iidim ;
  207.          incoid = 'EXTRAIRE' incod iidim ;
  208.          dpsi = 'MANUEL' 'CHPO' ppert 1 incoip eps ;
  209.          'FORME' dpsi ;
  210. *      resper = RESID tabmod 'TEST' ;
  211.          resper =  DEADRESI _mt gdisc methgau theta gamma incod ;
  212.          'FORME' unpert ;
  213.          dresapp = '/' ('-' resper resunp) eps ;
  214.          dpert = 'MANUEL' 'CHPO' ppert 1 incoip 1.D0 ;
  215.          drescal = '*' jac dpert ;
  216.          erro  = '/' ('**' ('XTX' ('-' drescal dresapp)) 0.5D0)
  217.                      ('**' ('XTX' drescal) 0.5D0) ;
  218.          'MESSAGE' ('CHAINE' '   Composante ' incoip) ;
  219.          'MESSAGE' ('CHAINE' '   dresapp=') ; 'LISTE' dresapp ;
  220.          'MESSAGE' ('CHAINE' '   drescal=') ; 'LISTE' drescal ;
  221.          'MESSAGE' ('CHAINE' '   erro=' erro) ;
  222.          'SI' ('>' erro eps2) ;
  223.             'SI' interact ;
  224.                cherr = 'CHAINE' '!!!! erro=' erro ;
  225.                'ERREUR' cherr ;
  226.             'SINON' ;
  227.                'ERREUR' 5 ;
  228.             'FINSI' ;                                 
  229.          'FINSI' ;
  230.       'FIN' idim ;      
  231.    'FIN' dmail ;   
  232. 'FIN' desp ;
  233. 'SAUTER' 2 'LIGNE' ;
  234. 'MESSAGE' ('CHAINE' 'Tout sest bien passe !') ;
  235. 'SAUTER' 2 'LIGNE' ;
  236. 'OPTION' 'ECHO' 1 ;
  237. *
  238. 'SI' interact ;
  239.    'OPTION' 'ECHO' 1 ;
  240.    'OPTION' 'DONN' 5 ;
  241. 'FINSI' ;   
  242. *
  243. * End of dgibi file TRJ_REGU
  244. *
  245. 'FIN' ;
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  

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