Télécharger inelpr.eso

Retour à la liste

Numérotation des lignes :

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

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