Télécharger inelte.eso

Retour à la liste

Numérotation des lignes :

  1. C INELTE SOURCE GOUNAND 06/12/19 21:15:24 5612
  2. SUBROUTINE INELTE(MYLRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INELTE
  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 3,
  10. C de forme tétraèdrique.
  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, GPOFBU
  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 :
  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 : L2D0TE1
  68. REAL*8 UNS4
  69. PARAMETER (UNS4=0.25D0)
  70. * Elément de nom : L2D1TE4
  71. REAL*8 RAC3,TROS4
  72. PARAMETER (RAC3=1.7320508075688772935274463415059D0)
  73. PARAMETER (TROS4=0.75D0)
  74. * Elément de nom : H1D1TE4
  75. REAL*8 ZERO,UN
  76. PARAMETER (ZERO=0.D0,UN=1.D0)
  77. * Elément de nom : H1D2TE15
  78. REAL*8 UNS2,UNS3
  79. PARAMETER (UNS2=1.D0/2.D0,UNS3=1.D0/3.D0)
  80. *
  81. INTEGER INDDL
  82. *
  83. * Executable statements
  84. *
  85. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelte'
  86. *
  87. * Elément de nom : L2D0TE1
  88. * Sur un triangle : élément de Lagrange, fonction L2, approximation
  89. * nodale, espace de référence de dimension 3, 1 noeud, 1 degré de
  90. * liberté, degré de l'approximation : 0
  91. *
  92. * In INILRF : SEGINI ELCOUR
  93. CALL INILRF('L2D0TE1','TETRAEDRE','LAGRANGE','L2',
  94. $ 3,1,1,0,
  95. $ ELCOUR,
  96. $ IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. ELCOUR.XCONOD(1,1)=UNS4
  99. ELCOUR.XCONOD(2,1)=UNS4
  100. ELCOUR.XCONOD(3,1)=UNS4
  101. ELCOUR.NPQUAF(1)=15
  102. ELCOUR.NUMCMP(1)=1
  103. * Initialise la correspondance ddl-noeud+ord.der
  104. CALL INILAG(ELCOUR,IMPR,IRET)
  105. IF (IRET.NE.0) GOTO 9999
  106. * Génère une base polynômiale complète (dimension 3, degré 0)
  107. CALL GBAPCO(3,0,MYBPOL,IMPR,IRET)
  108. IF (IRET.NE.0) GOTO 9999
  109. ELCOUR.MBPOLY=MYBPOL
  110. SEGDES ELCOUR
  111. MYLRFS.LISEL(**)=ELCOUR
  112. *
  113. * Elément de nom : L2D1TE4
  114. * Sur un tétraèdre : élément de Lagrange, fonction L2, approximation
  115. * nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de
  116. * liberté, degré de l'approximation : 1
  117. *
  118. * In INILRF : SEGINI ELCOUR
  119. CALL INILRF('L2D1TE4','TETRAEDRE','LAGRANGE','L2',
  120. $ 3,4,4,1,
  121. $ ELCOUR,
  122. $ IMPR,IRET)
  123. IF (IRET.NE.0) GOTO 9999
  124. ELCOUR.XCONOD(1,1)=RAC3*UNS4
  125. ELCOUR.XCONOD(2,1)=RAC3*UNS4
  126. ELCOUR.XCONOD(3,1)=UNS4
  127. ELCOUR.XCONOD(1,2)=RAC3*TROS4
  128. ELCOUR.XCONOD(2,2)=RAC3*UNS4
  129. ELCOUR.XCONOD(3,2)=UNS4
  130. ELCOUR.XCONOD(1,3)=RAC3*TROS4
  131. ELCOUR.XCONOD(2,3)=RAC3*TROS4
  132. ELCOUR.XCONOD(3,3)=UNS4
  133. ELCOUR.XCONOD(1,4)=RAC3*UNS4
  134. ELCOUR.XCONOD(2,4)=RAC3*UNS4
  135. ELCOUR.XCONOD(3,4)=TROS4
  136. ELCOUR.NPQUAF(1)=15
  137. ELCOUR.NUMCMP(1)=1
  138. ELCOUR.NPQUAF(2)=15
  139. ELCOUR.NUMCMP(2)=2
  140. ELCOUR.NPQUAF(3)=15
  141. ELCOUR.NUMCMP(3)=3
  142. ELCOUR.NPQUAF(4)=15
  143. ELCOUR.NUMCMP(4)=4
  144. * Initialise la correspondance ddl-noeud+ord.der
  145. CALL INILAG(ELCOUR,IMPR,IRET)
  146. IF (IRET.NE.0) GOTO 9999
  147. * Génère une base polynômiale complète (dimension 3, degré 1)
  148. CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  149. IF (IRET.NE.0) GOTO 9999
  150. ELCOUR.MBPOLY=MYBPOL
  151. SEGDES ELCOUR
  152. MYLRFS.LISEL(**)=ELCOUR
  153. *
  154. * Elément de nom : H1D1TE4
  155. * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation
  156. * nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de
  157. * liberté, degré de l'approximation : 1, degré du polynôme
  158. * d'interpolation 1
  159. *
  160. * In INILRF : SEGINI ELCOUR
  161. CALL INILRF('H1D1TE4','TETRAEDRE','LAGRANGE','H1',
  162. $ 3,4,4,1,
  163. $ ELCOUR,
  164. $ IMPR,IRET)
  165. IF (IRET.NE.0) GOTO 9999
  166. ELCOUR.XCONOD(1,1)=ZERO
  167. ELCOUR.XCONOD(2,1)=ZERO
  168. ELCOUR.XCONOD(3,1)=ZERO
  169. ELCOUR.XCONOD(1,2)=UN
  170. ELCOUR.XCONOD(2,2)=ZERO
  171. ELCOUR.XCONOD(3,2)=ZERO
  172. ELCOUR.XCONOD(1,3)=ZERO
  173. ELCOUR.XCONOD(2,3)=UN
  174. ELCOUR.XCONOD(3,3)=ZERO
  175. ELCOUR.XCONOD(1,4)=ZERO
  176. ELCOUR.XCONOD(2,4)=ZERO
  177. ELCOUR.XCONOD(3,4)=UN
  178. * Les d.d.l. sont aux noeuds 1,3,5,10
  179. ELCOUR.NPQUAF(1)=1
  180. ELCOUR.NPQUAF(2)=3
  181. ELCOUR.NPQUAF(3)=5
  182. ELCOUR.NPQUAF(4)=10
  183. DO 213 INDDL=1,4
  184. ELCOUR.NUMCMP(INDDL)=1
  185. 213 CONTINUE
  186. * Initialise la correspondance ddl-noeud+ord.der
  187. CALL INILAG(ELCOUR,IMPR,IRET)
  188. IF (IRET.NE.0) GOTO 9999
  189. * Génère une base polynômiale complète (dimension 3, degré 1)
  190. CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  191. IF (IRET.NE.0) GOTO 9999
  192. ELCOUR.MBPOLY=MYBPOL
  193. SEGDES ELCOUR
  194. MYLRFS.LISEL(**)=ELCOUR
  195. *
  196. * Elément de nom : CRD1TE4
  197. * Sur un tétraèdre : élément de Lagrange, fonction continue au centre
  198. * des faces, approximation
  199. * nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de
  200. * liberté, degré de l'approximation : 1, degré du polynôme
  201. * d'interpolation 1
  202. *
  203. * In INILRF : SEGINI ELCOUR
  204. CALL INILRF('CRD1TE4','TETRAEDRE','LAGRANGE','H1',
  205. $ 3,4,4,1,
  206. $ ELCOUR,
  207. $ IMPR,IRET)
  208. IF (IRET.NE.0) GOTO 9999
  209. ELCOUR.XCONOD(1,1)=UNS3
  210. ELCOUR.XCONOD(2,1)=UNS3
  211. ELCOUR.XCONOD(3,1)=ZERO
  212. ELCOUR.XCONOD(1,2)=UNS3
  213. ELCOUR.XCONOD(2,2)=ZERO
  214. ELCOUR.XCONOD(3,2)=UNS3
  215. ELCOUR.XCONOD(1,3)=UNS3
  216. ELCOUR.XCONOD(2,3)=UNS3
  217. ELCOUR.XCONOD(3,3)=UNS3
  218. ELCOUR.XCONOD(1,4)=ZERO
  219. ELCOUR.XCONOD(2,4)=UNS3
  220. ELCOUR.XCONOD(3,4)=UNS3
  221. * Les d.d.l. sont aux noeuds 11,12,13,14
  222. DO INDDL=1,4
  223. ELCOUR.NPQUAF(INDDL)=INDDL+10
  224. ELCOUR.NUMCMP(INDDL)=1
  225. ENDDO
  226. * Initialise la correspondance ddl-noeud+ord.der
  227. CALL INILAG(ELCOUR,IMPR,IRET)
  228. IF (IRET.NE.0) GOTO 9999
  229. * Génère une base polynômiale complète (dimension 3, degré 1)
  230. CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  231. IF (IRET.NE.0) GOTO 9999
  232. ELCOUR.MBPOLY=MYBPOL
  233. SEGDES ELCOUR
  234. MYLRFS.LISEL(**)=ELCOUR
  235. *
  236. * Elément de nom : H1D1TE5
  237. * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation
  238. * nodale, espace de référence de dimension 3, 5 noeuds, 5 degrés de
  239. * liberté, degré de l'approximation : 1, degré du polynôme
  240. * d'interpolation 3
  241. *
  242. * In INILRF : SEGINI ELCOUR
  243. CALL INILRF('H1D1TE5','TETRAEDRE','LAGRANGE','H1',
  244. $ 3,5,5,1,
  245. $ ELCOUR,
  246. $ IMPR,IRET)
  247. IF (IRET.NE.0) GOTO 9999
  248. ELCOUR.XCONOD(1,1)=ZERO
  249. ELCOUR.XCONOD(2,1)=ZERO
  250. ELCOUR.XCONOD(3,1)=ZERO
  251. ELCOUR.XCONOD(1,2)=UN
  252. ELCOUR.XCONOD(2,2)=ZERO
  253. ELCOUR.XCONOD(3,2)=ZERO
  254. ELCOUR.XCONOD(1,3)=ZERO
  255. ELCOUR.XCONOD(2,3)=UN
  256. ELCOUR.XCONOD(3,3)=ZERO
  257. ELCOUR.XCONOD(1,4)=ZERO
  258. ELCOUR.XCONOD(2,4)=ZERO
  259. ELCOUR.XCONOD(3,4)=UN
  260. ELCOUR.XCONOD(1,5)=UNS4
  261. ELCOUR.XCONOD(2,5)=UNS4
  262. ELCOUR.XCONOD(3,5)=UNS4
  263. * Les d.d.l. sont aux noeuds 1,3,5,10,15
  264. ELCOUR.NPQUAF(1)=1
  265. ELCOUR.NPQUAF(2)=3
  266. ELCOUR.NPQUAF(3)=5
  267. ELCOUR.NPQUAF(4)=10
  268. ELCOUR.NPQUAF(5)=15
  269. DO 215 INDDL=1,5
  270. ELCOUR.NUMCMP(INDDL)=1
  271. 215 CONTINUE
  272. * Initialise la correspondance ddl-noeud+ord.der
  273. CALL INILAG(ELCOUR,IMPR,IRET)
  274. IF (IRET.NE.0) GOTO 9999
  275. * Génère une base polynômiale complète (dimension 3, degré 1)
  276. CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  277. IF (IRET.NE.0) GOTO 9999
  278. * On rajoute la bulle (\ksi \eta \zeta \lambda avec
  279. * \lambda=1-\ksi-\eta-\zeta)
  280. CALL GPOBUL(3,MYBPOL,IMPR,IRET)
  281. IF (IRET.NE.0) GOTO 9999
  282. ELCOUR.MBPOLY=MYBPOL
  283. SEGDES ELCOUR
  284. MYLRFS.LISEL(**)=ELCOUR
  285. *
  286. * Elément de nom : H1D2TE10
  287. * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation
  288. * nodale, espace de référence de dimension 3, 10 noeuds, 10 degrés de
  289. * liberté, degré de l'approximation : 2, degré du polynôme
  290. * d'interpolation 2
  291. *
  292. * In INILRF : SEGINI ELCOUR
  293. CALL INILRF('H1D2TE10','TETRAEDRE','LAGRANGE','H1',
  294. $ 3,10,10,2,
  295. $ ELCOUR,
  296. $ IMPR,IRET)
  297. IF (IRET.NE.0) GOTO 9999
  298. ELCOUR.XCONOD(1,1)=ZERO
  299. ELCOUR.XCONOD(2,1)=ZERO
  300. ELCOUR.XCONOD(3,1)=ZERO
  301. ELCOUR.XCONOD(1,2)=UNS2
  302. ELCOUR.XCONOD(2,2)=ZERO
  303. ELCOUR.XCONOD(3,2)=ZERO
  304. ELCOUR.XCONOD(1,3)=UN
  305. ELCOUR.XCONOD(2,3)=ZERO
  306. ELCOUR.XCONOD(3,3)=ZERO
  307. ELCOUR.XCONOD(1,4)=UNS2
  308. ELCOUR.XCONOD(2,4)=UNS2
  309. ELCOUR.XCONOD(3,4)=ZERO
  310. ELCOUR.XCONOD(1,5)=ZERO
  311. ELCOUR.XCONOD(2,5)=UN
  312. ELCOUR.XCONOD(3,5)=ZERO
  313. ELCOUR.XCONOD(1,6)=ZERO
  314. ELCOUR.XCONOD(2,6)=UNS2
  315. ELCOUR.XCONOD(3,6)=ZERO
  316. ELCOUR.XCONOD(1,7)=ZERO
  317. ELCOUR.XCONOD(2,7)=ZERO
  318. ELCOUR.XCONOD(3,7)=UNS2
  319. ELCOUR.XCONOD(1,8)=UNS2
  320. ELCOUR.XCONOD(2,8)=ZERO
  321. ELCOUR.XCONOD(3,8)=UNS2
  322. ELCOUR.XCONOD(1,9)=ZERO
  323. ELCOUR.XCONOD(2,9)=UNS2
  324. ELCOUR.XCONOD(3,9)=UNS2
  325. ELCOUR.XCONOD(1,10)=ZERO
  326. ELCOUR.XCONOD(2,10)=ZERO
  327. ELCOUR.XCONOD(3,10)=UN
  328. * Les d.d.l. sont aux noeuds 1,...,10
  329. DO 217 INDDL=1,10
  330. ELCOUR.NPQUAF(INDDL)=INDDL
  331. ELCOUR.NUMCMP(INDDL)=1
  332. 217 CONTINUE
  333. * Initialise la correspondance ddl-noeud+ord.der
  334. CALL INILAG(ELCOUR,IMPR,IRET)
  335. IF (IRET.NE.0) GOTO 9999
  336. * Génère une base polynômiale complète (dimension 3, degré 2)
  337. CALL GBAPCO(3,2,MYBPOL,IMPR,IRET)
  338. IF (IRET.NE.0) GOTO 9999
  339. ELCOUR.MBPOLY=MYBPOL
  340. SEGDES ELCOUR
  341. MYLRFS.LISEL(**)=ELCOUR
  342. *
  343. * Elément de nom : H1D2TE15
  344. * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation
  345. * nodale, espace de référence de dimension 3, 15 noeuds, 15 degrés de
  346. * liberté, degré de l'approximation : 2, degré du polynôme
  347. * d'interpolation 4
  348. *
  349. * In INILRF : SEGINI ELCOUR
  350. CALL INILRF('H1D2TE15','TETRAEDRE','LAGRANGE','H1',
  351. $ 3,15,15,2,
  352. $ ELCOUR,
  353. $ IMPR,IRET)
  354. IF (IRET.NE.0) GOTO 9999
  355. ELCOUR.XCONOD(1,1)=ZERO
  356. ELCOUR.XCONOD(2,1)=ZERO
  357. ELCOUR.XCONOD(3,1)=ZERO
  358. ELCOUR.XCONOD(1,2)=UNS2
  359. ELCOUR.XCONOD(2,2)=ZERO
  360. ELCOUR.XCONOD(3,2)=ZERO
  361. ELCOUR.XCONOD(1,3)=UN
  362. ELCOUR.XCONOD(2,3)=ZERO
  363. ELCOUR.XCONOD(3,3)=ZERO
  364. ELCOUR.XCONOD(1,4)=UNS2
  365. ELCOUR.XCONOD(2,4)=UNS2
  366. ELCOUR.XCONOD(3,4)=ZERO
  367. ELCOUR.XCONOD(1,5)=ZERO
  368. ELCOUR.XCONOD(2,5)=UN
  369. ELCOUR.XCONOD(3,5)=ZERO
  370. ELCOUR.XCONOD(1,6)=ZERO
  371. ELCOUR.XCONOD(2,6)=UNS2
  372. ELCOUR.XCONOD(3,6)=ZERO
  373. ELCOUR.XCONOD(1,7)=ZERO
  374. ELCOUR.XCONOD(2,7)=ZERO
  375. ELCOUR.XCONOD(3,7)=UNS2
  376. ELCOUR.XCONOD(1,8)=UNS2
  377. ELCOUR.XCONOD(2,8)=ZERO
  378. ELCOUR.XCONOD(3,8)=UNS2
  379. ELCOUR.XCONOD(1,9)=ZERO
  380. ELCOUR.XCONOD(2,9)=UNS2
  381. ELCOUR.XCONOD(3,9)=UNS2
  382. ELCOUR.XCONOD(1,10)=ZERO
  383. ELCOUR.XCONOD(2,10)=ZERO
  384. ELCOUR.XCONOD(3,10)=UN
  385. ELCOUR.XCONOD(1,11)=UNS3
  386. ELCOUR.XCONOD(2,11)=UNS3
  387. ELCOUR.XCONOD(3,11)=ZERO
  388. ELCOUR.XCONOD(1,12)=UNS3
  389. ELCOUR.XCONOD(2,12)=ZERO
  390. ELCOUR.XCONOD(3,12)=UNS3
  391. ELCOUR.XCONOD(1,13)=UNS3
  392. ELCOUR.XCONOD(2,13)=UNS3
  393. ELCOUR.XCONOD(3,13)=UNS3
  394. ELCOUR.XCONOD(1,14)=ZERO
  395. ELCOUR.XCONOD(2,14)=UNS3
  396. ELCOUR.XCONOD(3,14)=UNS3
  397. ELCOUR.XCONOD(1,15)=UNS4
  398. ELCOUR.XCONOD(2,15)=UNS4
  399. ELCOUR.XCONOD(3,15)=UNS4
  400. * Les d.d.l. sont aux noeuds 1,...,15
  401. DO 219 INDDL=1,15
  402. ELCOUR.NPQUAF(INDDL)=INDDL
  403. ELCOUR.NUMCMP(INDDL)=1
  404. 219 CONTINUE
  405. * Initialise la correspondance ddl-noeud+ord.der
  406. CALL INILAG(ELCOUR,IMPR,IRET)
  407. IF (IRET.NE.0) GOTO 9999
  408. * Génère une base polynômiale complète (dimension 3, degré 2)
  409. CALL GBAPCO(3,2,MYBPOL,IMPR,IRET)
  410. IF (IRET.NE.0) GOTO 9999
  411. * On rajoute la bulle (\ksi \eta \zeta \lambda avec
  412. * \lambda=1-\ksi-\eta-\zeta)
  413. CALL GPOBUL(3,MYBPOL,IMPR,IRET)
  414. IF (IRET.NE.0) GOTO 9999
  415. * On rajoute les 4 bulles aux faces (\ksi \eta \zeta \lambda avec
  416. * \lambda=1-\ksi-\eta-\zeta)
  417. CALL GPOFBU(3,MYBPOL,IMPR,IRET)
  418. IF (IRET.NE.0) GOTO 9999
  419. ELCOUR.MBPOLY=MYBPOL
  420. SEGDES ELCOUR
  421. MYLRFS.LISEL(**)=ELCOUR
  422. *
  423. * Normal termination
  424. *
  425. IRET=0
  426. RETURN
  427. *
  428. * Format handling
  429. *
  430. *
  431. * Error handling
  432. *
  433. 9999 CONTINUE
  434. IRET=1
  435. WRITE(IOIMP,*) 'An error was detected in subroutine inelte'
  436. RETURN
  437. *
  438. * End of subroutine INELTE
  439. *
  440. END
  441.  
  442.  
  443.  
  444.  
  445.  

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