Télécharger ch_thetx.procedur

Retour à la liste

Numérotation des lignes :

  1. * CH_THETX PROCEDUR CB215821 16/06/14 21:15:01 8966
  2. *
  3. DEBPROC CH_THETX SUPTAB*TABLE ;
  4. *|=====================================================================|
  5. *| |
  6. *| << OBJET >> : |
  7. *| |
  8. *| Procedure analogue a CH_THETA mais utilisee avec des elements XFEM |
  9. *| Procedure determinant un champ/point de type THETA, c'est-a-dire |
  10. *| un champ/point dont la norme est constante a l'interieur d'une |
  11. *| courronne entourant le front d'une fissure, zero a l'exterieur de |
  12. *| cette couronne. Le vecteur represente par le champ THETA indique |
  13. *| la direction de propagation eventuelle de la fissure. |
  14. *| |
  15. *| << ENTREE >> : |
  16. *| |
  17. *| SUPTAB = Objet de type TABLE dont les indices sont des |
  18. *| objets de type MOT (a ecrire en toutes lettres) : |
  19. *| |
  20. *| ARGUMENTS OBLIGATOIRES |
  21. *| °°°°°°°°°°°°°°°°°°°°°° |
  22. *| |
  23. *| SUPTAB.'MAILLAGE' = Objet de type MAILLAGE representant soit |
  24. *| la structure totale etudiee (maillage |
  25. *| utilise dans l'analyse par elements finis, |
  26. *| soit, pour reduire le temps de calcul, le |
  27. *| maillage entourant le plus grand des contours |
  28. *| qu'on a defini pour calculer le champ THETA. |
  29. *| |
  30. *| SUPTAB.'PSI' = Objet de type CHPOINT representant la 1ere level |
  31. *| decrivant le repere local de la fissure |
  32. *| SUPTAB.'PHI' = Objet de type CHPOINT representant la 2eme level |
  33. *| decrivant le repere local de la fissure |
  34. *| |
  35. *| SUPTAB.'FRONT_FISSURE' = Objet representant le front de fissure |
  36. *| - facultatif et de type POINT en 2D |
  37. *| - obligatoire et de type MAILLAGE (ligne) en 3D |
  38. *| |
  39. *| SUPTAB.'COUCHE' = Objet de type ENTIER representant le nombre |
  40. *| de couches d'elements (autour du point de |
  41. *| fissure) qui se deplacent pour simuler la |
  42. *| propagtion de la fissure. |
  43. *| |
  44. *| |
  45. *| |
  46. *| << SORTIE >> : |
  47. *| |
  48. *| TETA = Objet de type : |
  49. *| |
  50. *| - TABLE INDICEE PAR DES OBJETS DE TYPE POINT CONTENANT |
  51. *| DES ELEMENTS DE TYPE CHPOINT DANS LE CAS 3 DIMENSIONS. |
  52. *| CHAQUE ELEMENT CONTIENT LE CHAMP THETA AU NOEUD DU |
  53. *| FRONT DE COORDONNEES CELLES DU POINT P : TETA.P. ELLE |
  54. *| EST EGALEMENT INDICEE PAR LE MOT 'GLOBAL' POUR DONNER |
  55. *| LE CHAMP THETA GLOBAL LE LONG DE TOUT FRONT DE LA FISSURE |
  56. *| - ELEMENT DE TYPE CHPOINT CONTENANT LE CHAMP THETA EN 2 |
  57. *| DIMENSIONS (OU EN 3 DIMENSIONS AVEC DES ELEMENTS DE |
  58. *| COQUE MINCE) A LA POINTE DE FISSURE |
  59. *| |
  60. *| TABUTIL = Table avec la direction |
  61. *| |
  62. *|=====================================================================|
  63. &DIME = VALE DIME ;
  64. &MODE = VALE MODE ;
  65.  
  66. *---------------------------------------------------------*
  67. *-------- RECUP + TEST DE COMPABILITE DES DONNEES -------*
  68. *---------------------------------------------------------*
  69.  
  70. SI (NON (EXIS SUPTAB 'MAILLAGE'));
  71. MESS 'ERREUR : ON N A PAS TROUVE DANS LA'
  72. MESS ' TABLE L OBJET MAILLAGE';
  73. QUIT CH_THETX;
  74. SINON;
  75. MAILLAGE = SUPTAB.'MAILLAGE' ;
  76. * NB1 = NBNO (CHAN MAILLAGE 'POI1');
  77. FINSI;
  78. SI (NON (EXIS SUPTAB 'FRONT_FISSURE'));
  79. MESS 'ERREUR : LE FRONT DE LA FISSURE N EST PAS DONNE';
  80. QUIT CH_THETX;
  81. SINON;
  82. PFISS = SUPTAB.'FRONT_FISSURE';
  83. si(ega (type PFISS) 'POINT');
  84. PFISS1 = MANU 'POI1' PFISS;
  85. sino;
  86. PFISS1 = CHAN 'POI1' PFISS;
  87. fins;
  88. FINSI;
  89. SI ((NON (EXIS SUPTAB 'PSI')) ou (NON (EXIS SUPTAB 'PHI')));
  90. MESS 'ERREUR : CHPOINT PSI et PHI NON FOURNIS';
  91. QUIT CH_THETX;
  92. SINON;
  93. psy1 = SUPTAB . 'PSI';
  94. phy1 = SUPTAB . 'PHI';
  95. FINSI;
  96. SI (NON (EXIS SUPTAB 'COUCHE'));
  97. MESS 'ERREUR : ON VEUT LE NOMBRE DE COUCHES D ELEMENTS';
  98. MESS ' AUTOUR DE LA FISSURE QUI SE DEPLACE';
  99. MESS ' POUR SIMULER LA PROPAGATION DE LA FISSURE';
  100. QUIT CH_THETX;
  101. SINON;
  102. COUCHE = SUPTAB.'COUCHE' ;
  103. FINSI;
  104.  
  105. *--------------------------------------------------*
  106. * On veut savoir si une seule ou toutes les 2 levres
  107. * de la fissure ont été modelisees (bp, 2012-10-04)
  108. *--------------------------------------------------*
  109. XMULT = 1.;
  110. * si une demi-eprouvette est modelisee,
  111. * on espere que phi(x)>0 ou <0 qqsoit x
  112. miny1 = mini phy1; maxy1 = maxi phy1;
  113. si ((maxy1*miny1) <eg 0.);
  114. miny1a = mini (prog miny1 maxy1) 'ABS';
  115. maxy1a = maxi (prog miny1 maxy1) 'ABS';
  116. si( (miny1a/maxy1a) < 1.E-3);
  117. XMULT = 2.;
  118. fins;
  119. fins;
  120.  
  121.  
  122. TABUTIL = tabl;
  123.  
  124. *------------------------------------------------*
  125. *------- On determine TETA -------*
  126. *------------------------------------------------*
  127.  
  128. *------------------------------------------------*
  129. * CAS 2D ----------------------------------------*
  130. SI (&DIME EGA 2);
  131.  
  132. *--- Element contenant la Pointe de fissure, et Couches ------*
  133.  
  134. EFISS0= MAILLAGE ELEM 'CONTENANT' PFISS;
  135.  
  136. * test pour voir si on est sur un noeud, dans un element ou sur un bord
  137. mod0 = MODE EFISS0 'MECANIQUE' 'ELASTIQUE' 'XQ4R';
  138. psy10 = CHAN 'CHAM' mod0 (redu psy1 EFISS0) 'STRESSES';
  139. phy10 = CHAN 'CHAM' mod0 (redu phy1 EFISS0) 'STRESSES';
  140. logpsy10 = ((MAXI psy10) * (MINI psy10)) < 0.;
  141. logphy10 = ((MAXI phy10) * (MINI phy10)) < 0.;
  142. si(logpsy10 et logphy10);
  143. MBOUGER = EFISS0;
  144. sino;
  145. MBOUGER = EFISS0 POIN 'PROCH' PFISS;
  146. si((logpsy10 ou logphy10) et (ega COUCHE 0));
  147. mess 'ATTENTION : UTILISATION DE 0 COUCHE + XFEM DELICATE';
  148. mess ' RESULTAT PROBABLEMENT DE MAUVAISE PRECISION';
  149. fins;
  150. fins;
  151.  
  152. SI (COUCHE '>' 0);
  153. REPE BCOUCH COUCHE ;
  154. MBOUGER = ELEM MAILLAGE 'APPUYE' 'LARG' MBOUGER ;
  155. FIN BCOUCH ;
  156. FINSI;
  157. MAIL = ELEM MAILLAGE 'APPU' 'LARG' MBOUGER ;
  158. mod7 = MODE MAIL 'MECANIQUE' 'ELASTIQUE';
  159.  
  160. * Psi et Phi doivent etre entirement definis sur MAIL
  161. MINTER = INTE (CHAN 'POI1' MAIL) (EXTR psy1 'MAILLAGE');
  162. NBEL1 = NBEL (DIFF (CHAN 'POI1' MAIL) MINTER );
  163. SI (NBEL1 NEG 0) ;
  164. MESS NBEL1 'points des couches ou Psi et Phi sont indefinis';
  165. ERRE 21;
  166. FINS;
  167.  
  168.  
  169. *--- Vecteur direction unitaire ------*
  170. lv7 = (NOMC 'UX' psy1 'NATU' 'DIFFUS') ET
  171. (NOMC 'UY' phy1 'NATU' 'DIFFUS') ;
  172. glv7 = GRAD mod7 lv7 ;
  173.  
  174. * calcul basé sur grad de psi ou sur grad de phi ou les 2 ou autre...?
  175. * question delicate puisqu'elle met en jeu le pb des fissures courbes
  176. * et qui branchent.
  177. * grad(psi) est + facile a metter en oeuvre, notamment si presence de 2
  178. * pointes car le repere grad(psi), grad(phi) n'est pas direct des 2 cotés,
  179. * mais le vecteur direction ne semble pas tourner facilement
  180. teta7a= EXCO glv7 (mots 'UX,X' 'UX,Y') (mots 'UX' 'UY');
  181. teta7a= CHAN teta7a 'TYPE' 'SCALAIRE';
  182. * vteta7a = vect (chan chpo mod7 teta7a) 1.E-2 ROSE;
  183. * avec grad(phi) il y a 2 produits vectoriel a faire
  184. teta7b= EXCO glv7 (mots 'UY,X' 'UY,Y') (mots 'UX' 'UY');
  185. teta7b= CHAN teta7b 'TYPE' 'SCALAIRE';
  186. taw1 = ((exco teta7a 'UX' 'UZ') * (exco teta7b 'UY' 'UZ'))
  187. - ((exco teta7a 'UY' 'UZ') * (exco teta7b 'UX' 'UZ'));
  188. taw1 = CHAN taw1 'TYPE' 'SCALAIRE';
  189. teta7c=((exco teta7b 'UY' 'UX') * (exco taw1 'UZ' 'UX'))
  190. et (-1.* ((exco teta7b 'UX' 'UY') * (exco taw1 'UZ' 'UY')));
  191. * - ((exco teta7b 'UX' 'UY') * (exco taw1 'UZ' 'UY')); bug !!!
  192. * vteta7c = vect (chan chpo mod7 teta7c) (mots 'UX' 'UY') 1.E-2 BLEU;
  193.  
  194. teta7 = teta7c;
  195. * passage au noeud + normalisation du chamelem
  196. teta7 = CHAN teta7 mod7 'NOEUD';
  197. nteta7 = (PSCA teta7 teta7 (mots 'UX' 'UY') (mots 'UX' 'UY'))**(-0.5);
  198. * mess (maxi nteta7) (mini nteta7);
  199. teta7 = teta7 * nteta7;
  200. TETA = CHAN 'CHPO' mod7 teta7 'MOYE';
  201. TETA = REDU TETA MBOUGER;
  202.  
  203. * normalisation du chpoint + elargissement à MAIL
  204. nTETA = (PSCA TETA TETA (mots 'UX' 'UY') (mots 'UX' 'UY'))**(-0.5);
  205. TETA = (TETA * (nTETA * XMULT))
  206. + (MANU 'CHPO' MAIL 2 'UX' 0. 'UY' 0. 'NATURE' 'DIFFUS') ;
  207. * vteta = vect TETA 1.E-2 BLEU; trac vteta MAIL;
  208.  
  209.  
  210. *------ DIRECTIONs a garder dans la table TABUTIL ------*
  211.  
  212. VECTEUR1 = PROI PFISS1 teta7 ;
  213. *on utilise desormais un CHPOINT et plus un POINT
  214. TABUTIL .'DIRECTION1' = VECTEUR1;
  215. *on calule systematiquement DIRCISA = DIRTANG PVEC DIRTETA
  216. VECTEUR2 = (-1.*(EXCO VECTEUR1 'UY' 'UX'))
  217. et (EXCO VECTEUR1 'UX' 'UY');
  218. TABUTIL .'DIRECTION2' = VECTEUR2;
  219.  
  220. FINSI;
  221. * FIN DU CAS 2D ---------------------------------*
  222. *------------------------------------------------*
  223.  
  224.  
  225.  
  226. *------------------------------------------------*
  227. * CAS 3D ----------------------------------------*
  228. SI (&DIME EGA 3);
  229. * MESS 'ERREUR : CH_THETX NON PREVU EN 3D POUR L INSTANT';
  230. * MESS 'CH_THETX EN PHASE DE TEST EN 3D POUR L INSTANT';
  231.  
  232. *------ EFISS0 = ELEMENTS CONTENANT LE FRONT DE FISSURE ------*
  233. *
  234. MAILPSIP = EXTR psy1 'MAILLAGE';
  235. MAILPSIP = ELEM MAILLAGE 'APPUYE' 'STRICTEMENT' MAILPSIP;
  236. psy1e = CHAN 'CHAM' psy1 MAILPSIP;
  237. phy1e = CHAN 'CHAM' phy1 MAILPSIP;
  238. EFISS0 = ((ELEM psy1e 'EGSUPE' 0.) INTE (ELEM psy1e 'EGINFE' 0.))
  239. INTE ((ELEM phy1e 'EGSUPE' 0.) INTE (ELEM phy1e 'EGINFE' 0.));
  240. DX0 = ((MESU EFISS0 'VOLUME') / (nbel EFISS0)) ** (1./3.);
  241. EPS0P = 1.E-4 * DX0;
  242. EPS0N = -1.E-4 * DX0;
  243. EFISS0= ((ELEM psy1e 'EGSUP' EPS0N) INTE (ELEM psy1e 'EGINF' EPS0P))
  244. INTE ((ELEM phy1e 'EGSUP' EPS0N) INTE (ELEM phy1e 'EGINF' EPS0P));
  245.  
  246. *------ Recup de MBOUGER et de MAIL ------*
  247. *
  248. MBOUGER = EFISS0;
  249. * boucle sur les couches
  250. SI (COUCHE '>' 1);
  251. REPE BCOUCH (COUCHE - 1) ;
  252. MBOUGER = ELEM MAILLAGE 'APPUYE' 'LARG' MBOUGER ;
  253. FIN BCOUCH ;
  254. FINSI;
  255.  
  256. * MAIL = maillage de definition de TETA
  257. MAIL = ELEM MAILLAGE 'APPU' 'LARG' MBOUGER ;
  258.  
  259. * Psi et Phi doivent etre entirement definis sur MAIL
  260. MINTER = INTE (CHAN 'POI1' MAIL) (EXTR psy1 'MAILLAGE');
  261. NBEL1 = NBEL (DIFF (CHAN 'POI1' MAIL) MINTER );
  262. SI (NBEL1 NEG 0) ;
  263. MESS NBEL1 'points des couches ou Psi et Phi sont indefinis';
  264. ERRE 21;
  265. FINS;
  266.  
  267. * inutile de chercher a calculer + loin que le domaine de def de psi et phi
  268. MAIL = MAIL inte MAILPSIP;
  269. mod7 = MODE MAIL 'MECANIQUE' 'ELASTIQUE' ;
  270.  
  271. *--- Travail sur les level set
  272. * pour definir le repere local du front de fissure ------*
  273. *--- Creation du TETA global ------*
  274. *
  275. * Vecteur direction unitaire
  276. lv7 = (NOMC 'UX' psy1 'NATU' 'DIFFUS') ET
  277. (NOMC 'UY' phy1 'NATU' 'DIFFUS') ET
  278. (MANU 'CHPO' MAIL 1 'UZ' 0. 'NATU' 'DIFFUS');
  279. glv7 = GRAD mod7 lv7 ;
  280. gpsy1= EXCO glv7 (mots 'UX,X' 'UX,Y' 'UX,Z') (mots 'UX' 'UY' 'UZ');
  281. gpsy1= CHAN gpsy1 'TYPE' 'SCALAIRE';
  282. * gpsy1= CHAN gpsy1 'TYPE' 'DEPLACEMENT';
  283. gphy1s= EXCO glv7 (mots 'UY,X' 'UY,Y' 'UY,Z') (mots 'UX' 'UY' 'UZ');
  284. gphy1s= CHAN gphy1s 'TYPE' 'SCALAIRE';
  285. * gphy1= CHAN gpsy1 'TYPE' 'DEPLACEMENT';
  286. * mess '* taw1 = (grad PSI) pvec (grad PHI)';
  287. * ~(grad PSI) mais pas tout a fait...
  288. taw1s = ( ((exco gpsy1 'UY' 'UX') * (exco gphy1s 'UZ' 'UX'))
  289. - ((exco gpsy1 'UZ' 'UX') * (exco gphy1s 'UY' 'UX')) )
  290. et ( ((exco gpsy1 'UZ' 'UY') * (exco gphy1s 'UX' 'UY'))
  291. - ((exco gpsy1 'UX' 'UY') * (exco gphy1s 'UZ' 'UY')) )
  292. et ( ((exco gpsy1 'UX' 'UZ') * (exco gphy1s 'UY' 'UZ'))
  293. - ((exco gpsy1 'UY' 'UZ') * (exco gphy1s 'UX' 'UZ')) );
  294. taw1s = CHAN taw1s 'TYPE' 'SCALAIRE';
  295. teta1s = ( ((exco gphy1s 'UY' 'UX') * (exco taw1s 'UZ' 'UX'))
  296. - ((exco gphy1s 'UZ' 'UX') * (exco taw1s 'UY' 'UX')) )
  297. et ( ((exco gphy1s 'UZ' 'UY') * (exco taw1s 'UX' 'UY'))
  298. - ((exco gphy1s 'UX' 'UY') * (exco taw1s 'UZ' 'UY')) )
  299. et ( ((exco gphy1s 'UX' 'UZ') * (exco taw1s 'UY' 'UZ'))
  300. - ((exco gphy1s 'UY' 'UZ') * (exco taw1s 'UX' 'UZ')) );
  301.  
  302. * PASSAGE AU NOEUD DES CHAMELEMS (normalisation inutile?)
  303. teta1 = CHAN teta1s mod7 'NOEUD';
  304. * nteta1 = (PSCA teta1 teta1
  305. * (mots 'UX' 'UY' 'UZ') (mots 'UX' 'UY' 'UZ'))**(-0.5);
  306. * teta1 = teta1 * nteta1;
  307. gphy1= CHAN gphy1s mod7 'NOEUD';
  308. taw1 = CHAN taw1s mod7 'NOEUD';
  309. * ntaw1 = (PSCA taw1 taw1
  310. * (mots 'UX' 'UY' 'UZ') (mots 'UX' 'UY' 'UZ'))**(-0.5);
  311. * taw1 = taw1 * ntaw1;
  312.  
  313. * CREATION + NORMALISATION DES CHPOINTS
  314. * + REDU a MBOUGER + (re)-elargissement à MAIL
  315. * TETA
  316. TETA = CHAN 'CHPO' mod7 teta1 'MOYE';
  317. nTETA = (PSCA TETA TETA
  318. (mots 'UX' 'UY' 'UZ') (mots 'UX' 'UY' 'UZ'))**(-0.5);
  319. TETA = chan (TETA * nTETA) 'ATTRIBUT' 'NATURE' 'DIFFUS';
  320. TABUTIL . 'V1' = TETA;
  321. TETA = (REDU TETA MBOUGER);
  322. * + (MANU 'CHPO' MAIL 3 'UX' 0. 'UY' 0. 'UZ' 0. 'NATURE' 'DIFFUS') ;
  323. * TAW
  324. GPHY = CHAN 'CHPO' mod7 gphy1 'MOYE';
  325. nGPHY = (PSCA GPHY GPHY
  326. (mots 'UX' 'UY' 'UZ') (mots 'UX' 'UY' 'UZ'))**(-0.5);
  327. GPHY = chan (GPHY * nGPHY) 'ATTRIBUT' 'NATURE' 'DIFFUS';
  328. TABUTIL . 'V2' = GPHY;
  329. GPHY = (REDU GPHY MBOUGER);
  330. * + (MANU 'CHPO' MAIL 3 'UX' 0. 'UY' 0. 'UZ' 0. 'NATURE' 'DIFFUS') ;
  331. * TAW
  332. TAW = CHAN 'CHPO' mod7 taw1 'MOYE';
  333. nTAW = (PSCA TAW TAW
  334. (mots 'UX' 'UY' 'UZ') (mots 'UX' 'UY' 'UZ'))**(-0.5);
  335. TAW = chan (TAW * nTAW) 'ATTRIBUT' 'NATURE' 'DIFFUS';
  336. TABUTIL . 'V3' = TAW;
  337. TAW = (REDU TAW MBOUGER);
  338. * + (MANU 'CHPO' MAIL 3 'UX' 0. 'UY' 0. 'UZ' 0. 'NATURE' 'DIFFUS') ;
  339. *
  340. * trac ((vect TETA 0.05 'BLEU') et (vect TAW 0.05 'VERT'))
  341. * ((aret MAIL) et PFISS);
  342.  
  343.  
  344. *------ DIRECTIONs a garder dans la table TABUTIL ------*
  345.  
  346. * repere local du front
  347. * gphy7 = PROI gphy1 mod7 PFISS1;
  348. * teta7 = PROI teta1 mod7 PFISS1;
  349. * taw7 = PROI taw1 mod7 PFISS1;
  350. * => pas assez regulier => provoque des oscillations non symetrique
  351. * si 1 point du front (symetrique) appartient a la frontiere entre 2 elements
  352. gphy7 = INT_COMP MBOUGER GPHY PFISS1;
  353. teta7 = INT_COMP MBOUGER TETA PFISS1;
  354. taw7 = INT_COMP MBOUGER TAW PFISS1;
  355. * normalisation
  356. ngphy7 = (PSCA gphy7 gphy7
  357. (mots 'UX' 'UY' 'UZ') (mots 'UX' 'UY' 'UZ'))**(-0.5);
  358. gphy7 = gphy7 * ngphy7;
  359. nteta7 = (PSCA teta7 teta7
  360. (mots 'UX' 'UY' 'UZ') (mots 'UX' 'UY' 'UZ'))**(-0.5);
  361. teta7 = teta7 * nteta7;
  362. ntaw7 = (PSCA taw7 taw7
  363. (mots 'UX' 'UY' 'UZ') (mots 'UX' 'UY' 'UZ'))**(-0.5);
  364. taw7 = taw7 * ntaw7;
  365. *on utilise desormais des CHPOINT et plus des POINTs
  366. TABUTIL .'DIRECTION1' = chan teta7 'ATTRIBUT' 'NATURE' 'DIFFUS';
  367. TABUTIL .'DIRECTION2' = chan gphy7 'ATTRIBUT' 'NATURE' 'DIFFUS';
  368. TABUTIL .'DIRECTION3' = chan taw7 'ATTRIBUT' 'NATURE' 'DIFFUS';
  369.  
  370. * mess '*------ identification de chaque element du front ------*';
  371. *------ identification de chaque element du front ------*
  372. *
  373. * pour identifier les elem a bouger, on boucle sur les points du front
  374. nefiss1 = 0;
  375. EFISSi = tabl;
  376. nPFISS1 = NBEL PFISS1;
  377. ipfiss1 = 0;
  378. * boucle sur les points du front
  379. repe BPFISS1 nPFISS1;
  380. ipfiss1 = ipfiss1 + 1;
  381. PFISS1i = POIN PFISS1 ipfiss1;
  382.  
  383. * mess 'ch_thetx: ' ipfiss1 ' -> noeud' (noeu PFISS1i)
  384. * 'on cherche le(s) element(s)' (nefiss1 + 1);
  385.  
  386. * on recupere le(s) element(s) contenant le ieme point
  387. * Etesti = MBOUGER ELEM 'CONTENANT' PFISS1i;
  388. Etesti = MBOUGER ELEM 'CONTENANT' PFISS1i 'TOUS';
  389. * list Etesti;
  390.  
  391. si(ega ipfiss1 1);
  392. nefiss1 = nefiss1 + 1;
  393. EFISSi . nefiss1 = Etesti;
  394. * mess '1ere fois ->' nefiss1;
  395. sino;
  396.  
  397. * Etesti = diff Etesti (inte Etesti (EFISSi . nefiss1) 'NOVERIF');
  398. * si(neg (nbel Etesti) 0);
  399. * nefiss1 = nefiss1 + 1;
  400. * EFISSi . nefiss1 = Etesti;
  401. * fins;
  402.  
  403. * de base on enleve l eventuel element n-2
  404. si(nefiss1 >eg 2);
  405. Einte2 = inte Etesti (EFISSi . (nefiss1-1)) 'NOVERIF';
  406. si(neg (nbel Einte2) 0);
  407. Etesti = diff Etesti Einte2;
  408. si((nbel Etesti) ega 0);
  409. * mess 'tous les elements sont deja dans' (nefiss1-1) 'on itere' ;
  410. iter BPFISS1;
  411. fins;
  412. fins;
  413. fins;
  414.  
  415. * puis on fait le travail
  416. Einte = inte Etesti (EFISSi . nefiss1) 'NOVERIF';
  417. * mess 'on a' (nbel Einte) 'elements en commun avec' (nefiss1);
  418. si(ega (nbel Einte) 0);
  419. nefiss1 = nefiss1 + 1;
  420. EFISSi . nefiss1 = Etesti;
  421. * mess ' ->' nefiss1;
  422. sino;
  423. * il existe des elements en commun
  424. * on a peut etre trop pris d element dans l ancien...
  425. Etemp = diff (EFISSi . nefiss1) Einte;
  426. si(neg (nbel Etemp) 0);
  427. * mess ' on parvient a enlever des elements de lancien' nefiss1
  428. * ' qui existe encore' (nbel Etemp);
  429. * on enleve ce qu il y a en trop et on met ce qui reste dans le nouveau
  430. EFISSi . nefiss1 = Etemp;
  431. * Etesti = diff Etesti Etemp ;
  432. Einte = inte Etesti Etemp 'NOVERIF';
  433. Etesti = diff Etesti Einte;
  434. si(neg (nbel Etesti) 0);
  435. nefiss1 = nefiss1 + 1;
  436. EFISSi . nefiss1 = Etesti;
  437. * mess ' on stocke ce qui reste (soit ' (nbel Etesti) ' -> ' nefiss1;
  438. finsi;
  439. sino;
  440. * on a peut etre trop pris d element dans le nouveau...
  441. Etemp = diff Etesti Einte;
  442. si(neg (nbel Etemp) 0);
  443. nefiss1 = nefiss1 + 1;
  444. EFISSi . nefiss1 = Etemp;
  445. * mess ' on parvient a enlever des elements du nouveau'
  446. * ' qui existe encore' (nbel Etemp) ' -> ' nefiss1;
  447. fins;
  448. fins;
  449.  
  450. fins;
  451. fins;
  452. * list EFISSi;
  453. fin BPFISS1;
  454.  
  455.  
  456. *------ creation des TETA de chaque element du front ------*
  457. *
  458. TTETA = TABL;
  459. coef2 = 1.E-2 * DX0;
  460. * boucle sur les elements du front
  461. iefiss1 = 0;
  462. REPE BEFISS2 nefiss1;
  463. iefiss1 = iefiss1 + 1;
  464.  
  465. * chpoint TETA2 de chaque element contenant le front (=tranche)
  466. TETA2 = REDU TETA EFISSi . iefiss1;
  467.  
  468. * on replace les COUCHES ici en faisant une suite
  469. MBOUGERi = EFISSi . iefiss1;
  470. SI (COUCHE '>' 1);
  471. XCOUCH = 1.;
  472. REPE BCOUCH (COUCHE - 1) ;
  473. XCOUCH = XCOUCH + 1.;
  474. MBOUGERi = ELEM MAILLAGE 'APPUYE' 'LARG' MBOUGERi;
  475. TETA2 = TETA2 + (REDU TETA MBOUGERi) ;
  476. *bp_exp TETA2 = TETA2 + ((1./XCOUCH) * (REDU TETA MBOUGERi)) ;
  477. FIN BCOUCH ;
  478. *bp_lin TETA2 = TETA2 / (COUCHE - 1);
  479. FINSI;
  480. *bp_+loin TETA2 = REDU TETA MBOUGERi;
  481.  
  482. * trac (vect TETA2 DEPL BLEU) EFISS0;
  483. * TTETA . (EFISSi . iefiss1) = TETA2;
  484. * avancee VECTEUR2 de chaque element du front (=segment)
  485. * teta72 = PROI PFISS (redu teta7 EFISSi . iefiss1);
  486. * teta72 = INT_COMP EFISSi . iefiss1 TETA2 PFISS;
  487. teta72 = INT_COMP EFISS0 TETA2 PFISS;
  488. * trac (vect teta72 DEPL BLEU 0.03) ( EFISS0 et PFISS);
  489. * calcul de l'aire fracturee par cette avancee virtuelle
  490. *rem: si discretisation non conforme erreur/XAFISS2 peut etre importante
  491. PFISS2 = PFISS PLUS (teta72 * coef2);
  492. AFISS2 = PFISS2 REGL PFISS 1;
  493. * trac (vect teta72 DEPL BLEU 0.03) (EFISS0 et PFISS et AFISS2);
  494. XAFISS2 = (MESU AFISS2 'SURF') / coef2;
  495. * mess iefiss1 'ieme element de surface = ' XAFISS2;
  496. * trac (vect teta72 'DEPL') (AFISS2 et PFISS);
  497. TTETA . (EFISSi . iefiss1) = TETA2 * (XMULT / XAFISS2);
  498.  
  499. * nom0 = mots 'UX' 'UY' 'UZ';
  500. * nom1 = mots (chai 'UX' iefiss1)
  501. * (chai 'UY' iefiss1) (chai 'UZ' iefiss1);
  502. * si(iefiss1 ega 1);
  503. * toto = (TTETA . (EFISSi . iefiss1)) nomc nom0 nom1;
  504. * sinon;
  505. * toto = toto et
  506. * ((TTETA . (EFISSi . iefiss1)) nomc nom0 nom1);
  507. * finsi;
  508. *
  509.  
  510. FIN BEFISS2;
  511.  
  512. * opti sort 'THETA.inp';
  513. * sort 'AVS' MBOUGER toto;
  514.  
  515.  
  516.  
  517. * champ TETA global
  518. teta72 = INT_COMP EFISS0 TETA PFISS;
  519. PFISS2 = PFISS PLUS (teta72 * coef2);
  520. AFISS2 = PFISS2 REGL PFISS 1;
  521. XAFISS2 = (MESU AFISS2 'SURF') / coef2;
  522. TTETA . 'GLOBAL' = TETA * (XMULT / XAFISS2);
  523.  
  524. * pour renvoyer la table TTETA
  525. TETA = TTETA;
  526.  
  527. FINSI;
  528. * FIN DU CAS 3D ---------------------------------*
  529. *------------------------------------------------*
  530.  
  531.  
  532. FINPROC TETA TABUTIL;
  533. * Fin de la procedure CH_THETX
  534. *--------------------------------------------*
  535.  
  536.  
  537.  
  538.  
  539.  
  540.  
  541.  
  542.  

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