Télécharger ineltr.eso

Retour à la liste

Numérotation des lignes :

  1. C INELTR SOURCE GOUNAND 06/12/19 21:15:26 5612
  2. SUBROUTINE INELTR(MYLRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INELTR
  7. C PROJET : Noyau linéaire NLIN
  8. C DESCRIPTION : Remplit le segment des éléments de référence
  9. C avec les éléments de référence de dimension 2,
  10. C de forme triangulaire.
  11. C REFERENCES :
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES : INILRF, INILAG, GBAPCO, GPOBUL
  17. C APPELE PAR : INLRFS
  18. C***********************************************************************
  19. C ENTREES : -
  20. C ENTREES/SORTIES : MYLRFS
  21. C SORTIES : -
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 23/03/00, version initiale
  25. C HISTORIQUE : v1, 23/03/00, création
  26. C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF
  27. C HISTORIQUE : 26/07/02, ajout du triangle cubique
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34. -INC CCOPTIO
  35. CBEGININCLUDE SELREF
  36. SEGMENT ELREF
  37. CHARACTER*(LNNOM) NOMLRF
  38. CHARACTER*(LNFORM) FORME
  39. CHARACTER*(LNTYPL) TYPEL
  40. CHARACTER*(LNESP) ESPACE
  41. INTEGER DEGRE
  42. REAL*8 XCONOD(NDIMEL,NBNOD)
  43. INTEGER NPQUAF(NBDDL)
  44. INTEGER NUMCMP(NBDDL)
  45. INTEGER QUENOD(NBDDL)
  46. INTEGER ORDDER(NDIMEL,NBDDL)
  47. POINTEUR MBPOLY.POLYNS
  48. ENDSEGMENT
  49. SEGMENT ELREFS
  50. POINTEUR LISEL(0).ELREF
  51. ENDSEGMENT
  52. CENDINCLUDE SELREF
  53. POINTEUR MYLRFS.ELREFS
  54. POINTEUR ELCOUR.ELREF
  55. CBEGININCLUDE SPOLYNO
  56. SEGMENT POLYNO
  57. REAL*8 COEMON(NBMON)
  58. INTEGER EXPMON(NDIML,NBMON)
  59. ENDSEGMENT
  60. SEGMENT POLYNS
  61. POINTEUR LIPOLY(NBPOLY).POLYNO
  62. ENDSEGMENT
  63. CENDINCLUDE SPOLYNO
  64. POINTEUR MYBPOL.POLYNS
  65. *
  66. INTEGER IMPR,IRET
  67. * Elément de nom : L2D0TR1
  68. REAL*8 UNS3
  69. PARAMETER (UNS3=1.D0/3.D0)
  70. * Elément de nom : L2D1TR3
  71. REAL*8 UNS6,DEUXS3
  72. PARAMETER (UNS6=1.D0/6.D0,DEUXS3=2.D0/3.D0)
  73. * Elément de nom : H1D1TR3
  74. REAL*8 ZERO,UN
  75. PARAMETER (ZERO=0.D0,UN=1.D0)
  76. * Elément de nom : H1D2TR6
  77. REAL*8 UNS2
  78. PARAMETER (UNS2=1.D0/2.D0)
  79. *
  80. INTEGER INDDL
  81. *
  82. * Executable statements
  83. *
  84. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ineltr'
  85. *
  86. * Elément de nom : L2D0TR1
  87. * Sur un triangle : élément de Lagrange, fonction L2, approximation
  88. * nodale, espace de référence de dimension 2, 1 noeud, 1 degré de
  89. * liberté, degré de l'approximation : 0
  90. *
  91. * In INILRF : SEGINI ELCOUR
  92. CALL INILRF('L2D0TR1','TRIANGLE','LAGRANGE','L2',
  93. $ 2,1,1,0,
  94. $ ELCOUR,
  95. $ IMPR,IRET)
  96. IF (IRET.NE.0) GOTO 9999
  97. ELCOUR.XCONOD(1,1)=UNS3
  98. ELCOUR.XCONOD(2,1)=UNS3
  99. ELCOUR.NPQUAF(1)=7
  100. ELCOUR.NUMCMP(1)=1
  101. * Initialise la correspondance ddl-noeud+ord.der
  102. CALL INILAG(ELCOUR,IMPR,IRET)
  103. IF (IRET.NE.0) GOTO 9999
  104. * Génère une base polynômiale complète (dimension 2, degré 0)
  105. CALL GBAPCO(2,0,MYBPOL,IMPR,IRET)
  106. IF (IRET.NE.0) GOTO 9999
  107. ELCOUR.MBPOLY=MYBPOL
  108. SEGDES ELCOUR
  109. MYLRFS.LISEL(**)=ELCOUR
  110. *
  111. * Elément de nom : L2D1TR3
  112. * Sur un triangle : élément de Lagrange, fonction L2, approximation
  113. * nodale, espace de référence de dimension 2, 3 noeuds, 3 degrés de
  114. * liberté, degré de l'approximation : 1
  115. *
  116. * In INILRF : SEGINI ELCOUR
  117. CALL INILRF('L2D1TR3','L2D1TR3','LAGRANGE','L2',
  118. $ 2,3,3,1,
  119. $ ELCOUR,
  120. $ IMPR,IRET)
  121. IF (IRET.NE.0) GOTO 9999
  122. ELCOUR.XCONOD(1,1)=UNS6
  123. ELCOUR.XCONOD(2,1)=UNS6
  124. ELCOUR.XCONOD(1,2)=DEUXS3
  125. ELCOUR.XCONOD(2,2)=UNS6
  126. ELCOUR.XCONOD(1,3)=UNS6
  127. ELCOUR.XCONOD(2,3)=DEUXS3
  128. ELCOUR.NPQUAF(1)=7
  129. ELCOUR.NUMCMP(1)=1
  130. ELCOUR.NPQUAF(2)=7
  131. ELCOUR.NUMCMP(2)=2
  132. ELCOUR.NPQUAF(3)=7
  133. ELCOUR.NUMCMP(3)=3
  134. * Initialise la correspondance ddl-noeud+ord.der
  135. CALL INILAG(ELCOUR,IMPR,IRET)
  136. IF (IRET.NE.0) GOTO 9999
  137. * Génère une base polynômiale complète (dimension 2, degré 1)
  138. CALL GBAPCO(2,1,MYBPOL,IMPR,IRET)
  139. IF (IRET.NE.0) GOTO 9999
  140. ELCOUR.MBPOLY=MYBPOL
  141. SEGDES ELCOUR
  142. MYLRFS.LISEL(**)=ELCOUR
  143. *
  144. * Elément de nom : H1D1TR3
  145. * Sur un triangle : élément de Lagrange, fonction H1, approximation
  146. * nodale, espace de référence de dimension 2, 3 noeuds, 3 degrés de
  147. * liberté, degré de l'approximation : 1
  148. *
  149. * In INILRF : SEGINI ELCOUR
  150. CALL INILRF('H1D1TR3','TRIANGLE','LAGRANGE','H1',
  151. $ 2,3,3,1,
  152. $ ELCOUR,
  153. $ IMPR,IRET)
  154. IF (IRET.NE.0) GOTO 9999
  155. ELCOUR.XCONOD(1,1)=ZERO
  156. ELCOUR.XCONOD(2,1)=ZERO
  157. ELCOUR.XCONOD(1,2)=UN
  158. ELCOUR.XCONOD(2,2)=ZERO
  159. ELCOUR.XCONOD(1,3)=ZERO
  160. ELCOUR.XCONOD(2,3)=UN
  161. * Les d.d.l. sont aux noeuds 1,3,5
  162. DO 209 INDDL=1,3
  163. ELCOUR.NPQUAF(INDDL)=(2*INDDL)-1
  164. ELCOUR.NUMCMP(INDDL)=1
  165. 209 CONTINUE
  166. * Initialise la correspondance ddl-noeud+ord.der
  167. CALL INILAG(ELCOUR,IMPR,IRET)
  168. IF (IRET.NE.0) GOTO 9999
  169. * Génère une base polynômiale complète (dimension 2, degré 1)
  170. CALL GBAPCO(2,1,MYBPOL,IMPR,IRET)
  171. IF (IRET.NE.0) GOTO 9999
  172. ELCOUR.MBPOLY=MYBPOL
  173. SEGDES ELCOUR
  174. MYLRFS.LISEL(**)=ELCOUR
  175. *
  176. * Elément de nom : CRD1TR3
  177. * Sur un triangle : élément de Lagrange, fonction continue au centre
  178. * des faces,
  179. * approximation nodale, espace de référence de dimension 2, 3 noeuds, 3
  180. * degrés de liberté, degré de l'approximation : 1
  181. *
  182. * In INILRF : SEGINI ELCOUR
  183. CALL INILRF('CRD1TR3','TRIANGLE','LAGRANGE','HFAC',
  184. $ 2,3,3,1,
  185. $ ELCOUR,
  186. $ IMPR,IRET)
  187. IF (IRET.NE.0) GOTO 9999
  188. ELCOUR.XCONOD(1,1)=UNS2
  189. ELCOUR.XCONOD(2,1)=ZERO
  190. ELCOUR.XCONOD(1,2)=UNS2
  191. ELCOUR.XCONOD(2,2)=UNS2
  192. ELCOUR.XCONOD(1,3)=ZERO
  193. ELCOUR.XCONOD(2,3)=UNS2
  194. * Les d.d.l. sont aux noeuds 2,4,6
  195. DO 201 INDDL=1,3
  196. ELCOUR.NPQUAF(INDDL)=2*INDDL
  197. ELCOUR.NUMCMP(INDDL)=1
  198. 201 CONTINUE
  199. * Initialise la correspondance ddl-noeud+ord.der
  200. CALL INILAG(ELCOUR,IMPR,IRET)
  201. IF (IRET.NE.0) GOTO 9999
  202. * Génère une base polynômiale complète (dimension 2, degré 1)
  203. CALL GBAPCO(2,1,MYBPOL,IMPR,IRET)
  204. IF (IRET.NE.0) GOTO 9999
  205. ELCOUR.MBPOLY=MYBPOL
  206. SEGDES ELCOUR
  207. MYLRFS.LISEL(**)=ELCOUR
  208. *
  209. * Elément de nom : H1D1TR4
  210. * Sur un triangle : élément de Lagrange, fonction H1, approximation
  211. * nodale, espace de référence de dimension 2, 4 noeuds, 4 degrés de
  212. * liberté, degré de l'approximation : 1
  213. *
  214. * In INILRF : SEGINI ELCOUR
  215. CALL INILRF('H1D1TR4','TRIANGLE','LAGRANGE','H1',
  216. $ 2,4,4,1,
  217. $ ELCOUR,
  218. $ IMPR,IRET)
  219. IF (IRET.NE.0) GOTO 9999
  220. ELCOUR.XCONOD(1,1)=ZERO
  221. ELCOUR.XCONOD(2,1)=ZERO
  222. ELCOUR.XCONOD(1,2)=UN
  223. ELCOUR.XCONOD(2,2)=ZERO
  224. ELCOUR.XCONOD(1,3)=ZERO
  225. ELCOUR.XCONOD(2,3)=UN
  226. ELCOUR.XCONOD(1,4)=UNS3
  227. ELCOUR.XCONOD(2,4)=UNS3
  228. * Les d.d.l. sont aux noeuds 1,3,5 et 7
  229. DO 202 INDDL=1,4
  230. ELCOUR.NPQUAF(INDDL)=(2*INDDL)-1
  231. ELCOUR.NUMCMP(INDDL)=1
  232. 202 CONTINUE
  233. * Initialise la correspondance ddl-noeud+ord.der
  234. CALL INILAG(ELCOUR,IMPR,IRET)
  235. IF (IRET.NE.0) GOTO 9999
  236. * Génère une base polynômiale complète (dimension 2, degré 1)
  237. CALL GBAPCO(2,1,MYBPOL,IMPR,IRET)
  238. IF (IRET.NE.0) GOTO 9999
  239. * On rajoute la bulle (\ksi \eta \lambda avec \lambda=1-\ksi-\eta)
  240. CALL GPOBUL(2,MYBPOL,IMPR,IRET)
  241. IF (IRET.NE.0) GOTO 9999
  242. ELCOUR.MBPOLY=MYBPOL
  243. SEGDES ELCOUR
  244. MYLRFS.LISEL(**)=ELCOUR
  245. *
  246. * Elément de nom : H1D2TR6
  247. * Sur un triangle : élément de Lagrange, fonction H1, approximation
  248. * nodale, espace de référence de dimension 2, 6 noeuds, 6 degrés de
  249. * liberté, degré de l'approximation : 2
  250. *
  251. * In INILRF : SEGINI ELCOUR
  252. CALL INILRF('H1D2TR6','TRIANGLE','LAGRANGE','H1',
  253. $ 2,6,6,2,
  254. $ ELCOUR,
  255. $ IMPR,IRET)
  256. IF (IRET.NE.0) GOTO 9999
  257. ELCOUR.XCONOD(1,1)=ZERO
  258. ELCOUR.XCONOD(2,1)=ZERO
  259. ELCOUR.XCONOD(1,2)=UNS2
  260. ELCOUR.XCONOD(2,2)=ZERO
  261. ELCOUR.XCONOD(1,3)=UN
  262. ELCOUR.XCONOD(2,3)=ZERO
  263. ELCOUR.XCONOD(1,4)=UNS2
  264. ELCOUR.XCONOD(2,4)=UNS2
  265. ELCOUR.XCONOD(1,5)=ZERO
  266. ELCOUR.XCONOD(2,5)=UN
  267. ELCOUR.XCONOD(1,6)=ZERO
  268. ELCOUR.XCONOD(2,6)=UNS2
  269. * Les d.d.l. sont aux noeuds 1,2,3,4,5,6
  270. DO 207 INDDL=1,6
  271. ELCOUR.NPQUAF(INDDL)=INDDL
  272. ELCOUR.NUMCMP(INDDL)=1
  273. 207 CONTINUE
  274. * Initialise la correspondance ddl-noeud+ord.der
  275. CALL INILAG(ELCOUR,IMPR,IRET)
  276. IF (IRET.NE.0) GOTO 9999
  277. * Génère une base polynômiale complète (dimension 2, degré 2)
  278. CALL GBAPCO(2,2,MYBPOL,IMPR,IRET)
  279. IF (IRET.NE.0) GOTO 9999
  280. ELCOUR.MBPOLY=MYBPOL
  281. SEGDES ELCOUR
  282. MYLRFS.LISEL(**)=ELCOUR
  283. *
  284. * Elément de nom : H1D2TR7
  285. * Sur un triangle : élément de Lagrange, fonction H1, approximation
  286. * nodale, espace de référence de dimension 2, 7 noeuds, 7 degrés de
  287. * liberté, degré de l'approximation : 2
  288. *
  289. * In INILRF : SEGINI ELCOUR
  290. CALL INILRF('H1D2TR7','TRIANGLE','LAGRANGE','H1',
  291. $ 2,7,7,2,
  292. $ ELCOUR,
  293. $ IMPR,IRET)
  294. IF (IRET.NE.0) GOTO 9999
  295. ELCOUR.XCONOD(1,1)=ZERO
  296. ELCOUR.XCONOD(2,1)=ZERO
  297. ELCOUR.XCONOD(1,2)=UNS2
  298. ELCOUR.XCONOD(2,2)=ZERO
  299. ELCOUR.XCONOD(1,3)=UN
  300. ELCOUR.XCONOD(2,3)=ZERO
  301. ELCOUR.XCONOD(1,4)=UNS2
  302. ELCOUR.XCONOD(2,4)=UNS2
  303. ELCOUR.XCONOD(1,5)=ZERO
  304. ELCOUR.XCONOD(2,5)=UN
  305. ELCOUR.XCONOD(1,6)=ZERO
  306. ELCOUR.XCONOD(2,6)=UNS2
  307. ELCOUR.XCONOD(1,7)=UNS3
  308. ELCOUR.XCONOD(2,7)=UNS3
  309. * Les d.d.l. sont aux noeuds 1,2,3,4,5,6,7
  310. DO 208 INDDL=1,7
  311. ELCOUR.NPQUAF(INDDL)=INDDL
  312. ELCOUR.NUMCMP(INDDL)=1
  313. 208 CONTINUE
  314. * Initialise la correspondance ddl-noeud+ord.der
  315. CALL INILAG(ELCOUR,IMPR,IRET)
  316. IF (IRET.NE.0) GOTO 9999
  317. * Génère une base polynômiale complète (dimension 2, degré 2)
  318. CALL GBAPCO(2,2,MYBPOL,IMPR,IRET)
  319. IF (IRET.NE.0) GOTO 9999
  320. * On rajoute la bulle (\ksi \eta \lambda avec \lambda=1-\ksi-\eta)
  321. CALL GPOBUL(2,MYBPOL,IMPR,IRET)
  322. IF (IRET.NE.0) GOTO 9999
  323. ELCOUR.MBPOLY=MYBPOL
  324. SEGDES ELCOUR
  325. MYLRFS.LISEL(**)=ELCOUR
  326. *
  327. * Elément de nom : H1D3TR10
  328. * Sur un triangle : élément de Lagrange, fonction H1, approximation
  329. * nodale, espace de référence de dimension 2, 10 noeuds, 10 degrés de
  330. * liberté, degré de l'approximation : 3
  331. *
  332. * In INILRF : SEGINI ELCOUR
  333. CALL INILRF('H1D3TR10','TRIANGLE','LAGRANGE','H1',
  334. $ 2,10,10,3,
  335. $ ELCOUR,
  336. $ IMPR,IRET)
  337. IF (IRET.NE.0) GOTO 9999
  338. ELCOUR.XCONOD(1,1)=ZERO
  339. ELCOUR.XCONOD(2,1)=ZERO
  340. ELCOUR.XCONOD(1,2)=UNS3
  341. ELCOUR.XCONOD(2,2)=ZERO
  342. ELCOUR.XCONOD(1,3)=DEUXS3
  343. ELCOUR.XCONOD(2,3)=ZERO
  344. ELCOUR.XCONOD(1,4)=UN
  345. ELCOUR.XCONOD(2,4)=ZERO
  346. ELCOUR.XCONOD(1,5)=DEUXS3
  347. ELCOUR.XCONOD(2,5)=UNS3
  348. ELCOUR.XCONOD(1,6)=UNS3
  349. ELCOUR.XCONOD(2,6)=DEUXS3
  350. ELCOUR.XCONOD(1,7)=ZERO
  351. ELCOUR.XCONOD(2,7)=UN
  352. ELCOUR.XCONOD(1,8)=ZERO
  353. ELCOUR.XCONOD(2,8)=DEUXS3
  354. ELCOUR.XCONOD(1,9)=ZERO
  355. ELCOUR.XCONOD(2,9)=UNS3
  356. ELCOUR.XCONOD(1,10)=UNS3
  357. ELCOUR.XCONOD(2,10)=UNS3
  358. * Attention ! Il y a deux degrés de liberté par face
  359. ELCOUR.NPQUAF(1)=1
  360. ELCOUR.NUMCMP(1)=1
  361. ELCOUR.NPQUAF(2)=2
  362. ELCOUR.NUMCMP(2)=1
  363. ELCOUR.NPQUAF(3)=2
  364. ELCOUR.NUMCMP(3)=2
  365. ELCOUR.NPQUAF(4)=3
  366. ELCOUR.NUMCMP(4)=1
  367. ELCOUR.NPQUAF(5)=4
  368. ELCOUR.NUMCMP(5)=1
  369. ELCOUR.NPQUAF(6)=4
  370. ELCOUR.NUMCMP(6)=2
  371. ELCOUR.NPQUAF(7)=5
  372. ELCOUR.NUMCMP(7)=1
  373. ELCOUR.NPQUAF(8)=6
  374. ELCOUR.NUMCMP(8)=1
  375. ELCOUR.NPQUAF(9)=6
  376. ELCOUR.NUMCMP(9)=2
  377. ELCOUR.NPQUAF(10)=7
  378. ELCOUR.NUMCMP(10)=1
  379. * Initialise la correspondance ddl-noeud+ord.der
  380. CALL INILAG(ELCOUR,IMPR,IRET)
  381. IF (IRET.NE.0) GOTO 9999
  382. * Génère une base polynômiale complète (dimension 2, degré 3)
  383. CALL GBAPCO(2,3,MYBPOL,IMPR,IRET)
  384. IF (IRET.NE.0) GOTO 9999
  385. ELCOUR.MBPOLY=MYBPOL
  386. SEGDES ELCOUR
  387. MYLRFS.LISEL(**)=ELCOUR
  388. *
  389. * Elément de nom : H10D0TR1
  390. * Sur un triangle : élément de Lagrange, fonction H1 "bulle" (nulle sur
  391. * les bords, approximation nodale, espace de référence de dimension 2,
  392. * 1 noeud, 1 degré de liberté, degré de l'approximation : 0 ?
  393. *
  394. * In INILRF : SEGINI ELCOUR
  395. CALL INILRF('H10D0TR1','TRIANGLE','LAGRANGE','H10',
  396. $ 2,1,1,0,
  397. $ ELCOUR,
  398. $ IMPR,IRET)
  399. IF (IRET.NE.0) GOTO 9999
  400. ELCOUR.XCONOD(1,1)=UNS3
  401. ELCOUR.XCONOD(2,1)=UNS3
  402. * Le d.d.l. est au noeud 7
  403. ELCOUR.NPQUAF(1)=7
  404. ELCOUR.NUMCMP(1)=1
  405. * Initialise la correspondance ddl-noeud+ord.der
  406. CALL INILAG(ELCOUR,IMPR,IRET)
  407. IF (IRET.NE.0) GOTO 9999
  408. NBPOLY=0
  409. SEGINI MYBPOL
  410. SEGDES MYBPOL
  411. * Génère la bulle (\ksi \eta \lambda avec \lambda=1-\ksi-\eta)
  412. CALL GPOBUL(2,MYBPOL,IMPR,IRET)
  413. IF (IRET.NE.0) GOTO 9999
  414. ELCOUR.MBPOLY=MYBPOL
  415. SEGDES ELCOUR
  416. MYLRFS.LISEL(**)=ELCOUR
  417. *
  418. * Normal termination
  419. *
  420. IRET=0
  421. RETURN
  422. *
  423. * Format handling
  424. *
  425. *
  426. * Error handling
  427. *
  428. 9999 CONTINUE
  429. IRET=1
  430. WRITE(IOIMP,*) 'An error was detected in subroutine ineltr'
  431. RETURN
  432. *
  433. * End of subroutine INELTR
  434. *
  435. END
  436.  
  437.  
  438.  
  439.  
  440.  

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