Télécharger inelcu.eso

Retour à la liste

Numérotation des lignes :

  1. C INELCU SOURCE GOUNAND 06/12/19 21:15:18 5612
  2. SUBROUTINE INELCU(MYLRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INELCU
  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 cubique.
  11. C
  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, FILRF, PROLRF, INILAG, PROBAP, GBAPCO
  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. POINTEUR ELPRO1.ELREF
  56. POINTEUR ELPRO2.ELREF
  57. CBEGININCLUDE SPOLYNO
  58. SEGMENT POLYNO
  59. REAL*8 COEMON(NBMON)
  60. INTEGER EXPMON(NDIML,NBMON)
  61. ENDSEGMENT
  62. SEGMENT POLYNS
  63. POINTEUR LIPOLY(NBPOLY).POLYNO
  64. ENDSEGMENT
  65. CENDINCLUDE SPOLYNO
  66. POINTEUR MYBPOL.POLYNS
  67. POINTEUR MYBPO1.POLYNS
  68. POINTEUR MYBPO2.POLYNS
  69. *
  70. INTEGER IMPR,IRET
  71. * Elément de nom : L2D1CU4
  72. REAL*8 ZERO,UNS2,UN
  73. PARAMETER (ZERO=0.D0,UNS2=0.5D0,UN=1.D0)
  74. *
  75. INTEGER INDDL
  76. *
  77. * Executable statements
  78. *
  79. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelcu'
  80. *
  81. * Elément de nom : L2D0CU1
  82. * Sur un cube : élément de Lagrange, fonction L2, approximation
  83. * nodale, espace de référence de dimension 3, 1 noeud, 1 degrés de
  84. * liberté, degré de l'approximation : 0
  85. *
  86. * In INILRF : SEGINI ELCOUR
  87. CALL INILRF('L2D0CU1','CUBE','LAGRANGE','L2',
  88. $ 3,1,1,0,
  89. $ ELCOUR,
  90. $ IMPR,IRET)
  91. IF (IRET.NE.0) GOTO 9999
  92. CALL FILRF('L2D0QU1',MYLRFS,ELPRO1,IMPR,IRET)
  93. IF (IRET.NE.0) GOTO 9999
  94. CALL FILRF('L2D0SE1',MYLRFS,ELPRO2,IMPR,IRET)
  95. IF (IRET.NE.0) GOTO 9999
  96. CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. ELCOUR.NPQUAF(1)=27
  99. ELCOUR.NUMCMP(1)=1
  100. * Initialise la correspondance ddl-noeud+ord.der
  101. CALL INILAG(ELCOUR,IMPR,IRET)
  102. IF (IRET.NE.0) GOTO 9999
  103. SEGACT ELPRO1
  104. MYBPO1=ELPRO1.MBPOLY
  105. SEGDES ELPRO1
  106. SEGACT ELPRO2
  107. MYBPO2=ELPRO2.MBPOLY
  108. SEGDES ELPRO2
  109. * Calcule la base polynômiale produit
  110. CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
  111. IF (IRET.NE.0) GOTO 9999
  112. ELCOUR.MBPOLY=MYBPOL
  113. SEGDES ELCOUR
  114. MYLRFS.LISEL(**)=ELCOUR
  115. *
  116. * Elément de nom : L2D1CU4
  117. * Sur un cube : élément de Lagrange, fonction L2, approximation
  118. * nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de
  119. * liberté, degré de l'approximation : 1
  120. *
  121. * In INILRF : SEGINI ELCOUR
  122. CALL INILRF('L2D1CU4','CUBE','LAGRANGE','L2',
  123. $ 3,4,4,1,
  124. $ ELCOUR,
  125. $ IMPR,IRET)
  126. IF (IRET.NE.0) GOTO 9999
  127. ELCOUR.XCONOD(1,1)= UNS2
  128. ELCOUR.XCONOD(2,1)= UNS2
  129. ELCOUR.XCONOD(3,1)=-UNS2
  130. ELCOUR.XCONOD(1,2)=-UNS2
  131. ELCOUR.XCONOD(2,2)= ZERO
  132. ELCOUR.XCONOD(3,2)=-UNS2
  133. ELCOUR.XCONOD(1,3)= ZERO
  134. ELCOUR.XCONOD(2,3)=-UNS2
  135. ELCOUR.XCONOD(3,3)=-UNS2
  136. ELCOUR.XCONOD(1,4)= ZERO
  137. ELCOUR.XCONOD(2,4)=-UNS2
  138. ELCOUR.XCONOD(3,4)= UNS2
  139. ELCOUR.NPQUAF(1)=27
  140. ELCOUR.NUMCMP(1)=1
  141. ELCOUR.NPQUAF(2)=27
  142. ELCOUR.NUMCMP(2)=2
  143. ELCOUR.NPQUAF(3)=27
  144. ELCOUR.NUMCMP(3)=3
  145. ELCOUR.NPQUAF(4)=27
  146. ELCOUR.NUMCMP(4)=4
  147. * Initialise la correspondance ddl-noeud+ord.der
  148. CALL INILAG(ELCOUR,IMPR,IRET)
  149. IF (IRET.NE.0) GOTO 9999
  150. * Génère une base polynômiale complète (dimension 3, degré 1)
  151. CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  152. IF (IRET.NE.0) GOTO 9999
  153. ELCOUR.MBPOLY=MYBPOL
  154. SEGDES ELCOUR
  155. MYLRFS.LISEL(**)=ELCOUR
  156. *
  157. * Elément de nom : CRD1CU6
  158. * Sur un cube : élément de Lagrange, fonction continue au centre
  159. * des faces, approximation
  160. * nodale, espace de référence de dimension 3, 6 noeuds, 6 degrés de
  161. * liberté, degré de l'approximation : 1
  162. *
  163. * In INILRF : SEGINI ELCOUR
  164. CALL INILRF('CRD1CU6','CUBE','LAGRANGE','HFAC',
  165. $ 3,6,6,1,
  166. $ ELCOUR,
  167. $ IMPR,IRET)
  168. IF (IRET.NE.0) GOTO 9999
  169. ELCOUR.XCONOD(1,1)=ZERO
  170. ELCOUR.XCONOD(2,1)=-UN
  171. ELCOUR.XCONOD(3,1)=ZERO
  172. ELCOUR.XCONOD(1,2)=UN
  173. ELCOUR.XCONOD(2,2)=ZERO
  174. ELCOUR.XCONOD(3,2)=ZERO
  175. ELCOUR.XCONOD(1,3)=ZERO
  176. ELCOUR.XCONOD(2,3)=UN
  177. ELCOUR.XCONOD(3,3)=ZERO
  178. ELCOUR.XCONOD(1,4)=-UN
  179. ELCOUR.XCONOD(2,4)=ZERO
  180. ELCOUR.XCONOD(3,4)=ZERO
  181. ELCOUR.XCONOD(1,5)=ZERO
  182. ELCOUR.XCONOD(2,5)=ZERO
  183. ELCOUR.XCONOD(3,5)=-UN
  184. ELCOUR.XCONOD(1,6)=ZERO
  185. ELCOUR.XCONOD(2,6)=ZERO
  186. ELCOUR.XCONOD(3,6)=+UN
  187. * Les d.d.l. sont aux noeuds 21 à 26...
  188. DO INDDL=1,6
  189. ELCOUR.NPQUAF(INDDL)=INDDL+20
  190. ELCOUR.NUMCMP(INDDL)=1
  191. ENDDO
  192. * Initialise la correspondance ddl-noeud+ord.der
  193. CALL INILAG(ELCOUR,IMPR,IRET)
  194. IF (IRET.NE.0) GOTO 9999
  195. * Génère une base polynômiale complète (dimension 3, degré 1)
  196. CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  197. IF (IRET.NE.0) GOTO 9999
  198. * On rajoute les polynômes spécifiques à crouzeix-raviart quadrilatère
  199. CALL GPOCRQ(3,MYBPOL,IMPR,IRET)
  200. IF (IRET.NE.0) GOTO 9999
  201. ELCOUR.MBPOLY=MYBPOL
  202. SEGDES ELCOUR
  203. MYLRFS.LISEL(**)=ELCOUR
  204. *
  205. * Elément de nom : H1D1CU8
  206. * Sur un cube : élément de Lagrange, fonction H1, approximation
  207. * nodale, espace de référence de dimension 3, 8 noeuds, 8 degrés de
  208. * liberté, degré de l'approximation : 1
  209. *
  210. * In INILRF : SEGINI ELCOUR
  211. CALL INILRF('H1D1CU8','CUBE','LAGRANGE','H1',
  212. $ 3,8,8,1,
  213. $ ELCOUR,
  214. $ IMPR,IRET)
  215. IF (IRET.NE.0) GOTO 9999
  216. CALL FILRF('H1D1QU4',MYLRFS,ELPRO1,IMPR,IRET)
  217. IF (IRET.NE.0) GOTO 9999
  218. CALL FILRF('H1D1SE2',MYLRFS,ELPRO2,IMPR,IRET)
  219. IF (IRET.NE.0) GOTO 9999
  220. CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
  221. IF (IRET.NE.0) GOTO 9999
  222. * Les d.d.l. sont aux noeuds 1,3,5,7...
  223. DO 201 INDDL=1,4
  224. ELCOUR.NPQUAF(INDDL)=(2*INDDL)-1
  225. ELCOUR.NUMCMP(INDDL)=1
  226. 201 CONTINUE
  227. * ... et 13,15,17,19.
  228. DO 203 INDDL=5,8
  229. ELCOUR.NPQUAF(INDDL)=(2*(INDDL-5))+13
  230. ELCOUR.NUMCMP(INDDL)=1
  231. 203 CONTINUE
  232. * Initialise la correspondance ddl-noeud+ord.der
  233. CALL INILAG(ELCOUR,IMPR,IRET)
  234. IF (IRET.NE.0) GOTO 9999
  235. SEGACT ELPRO1
  236. MYBPO1=ELPRO1.MBPOLY
  237. SEGDES ELPRO1
  238. SEGACT ELPRO2
  239. MYBPO2=ELPRO2.MBPOLY
  240. SEGDES ELPRO2
  241. * Calcule la base polynômiale produit
  242. CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
  243. IF (IRET.NE.0) GOTO 9999
  244. ELCOUR.MBPOLY=MYBPOL
  245. SEGDES ELCOUR
  246. MYLRFS.LISEL(**)=ELCOUR
  247. *
  248. * Elément de nom : H1D2CU20
  249. * Sur un cube : élément de Lagrange, fonction H1, approximation
  250. * nodale, espace de référence de dimension 3, 20 noeuds, 20 degrés de
  251. * liberté, degré de l'approximation : 2
  252. *
  253. * In INILRF : SEGINI ELCOUR
  254. CALL INILRF('H1D2CU20','CUBE','LAGRANGE','H1',
  255. $ 3,20,20,2,
  256. $ ELCOUR,
  257. $ IMPR,IRET)
  258. IF (IRET.NE.0) GOTO 9999
  259. C Inutile
  260. C ELCOUR.XCONOD(1,1)=ZERO
  261. C ELCOUR.XCONOD(2,1)=ZERO
  262. C ELCOUR.XCONOD(3,1)=ZERO
  263. * Les d.d.l sont aux noeuds 1,...,20
  264. DO IDDL=1,20
  265. ELCOUR.NPQUAF(IDDL)=IDDL
  266. ELCOUR.NUMCMP(IDDL)=1
  267. ENDDO
  268. * Initialise la correspondance ddl-noeud+ord.der
  269. CALL INILAG(ELCOUR,IMPR,IRET)
  270. IF (IRET.NE.0) GOTO 9999
  271. * Pas de base polynômiale (on recopie l'élément de castem)
  272. ELCOUR.MBPOLY=0
  273. SEGDES ELCOUR
  274. MYLRFS.LISEL(**)=ELCOUR
  275. *
  276. * Elément de nom : H1D2CU27
  277. * Sur un cube : élément de Lagrange, fonction H1, approximation
  278. * nodale, espace de référence de dimension 3, 27 noeuds, 27 degrés de
  279. * liberté, degré de l'approximation : 2
  280. *
  281. * In INILRF : SEGINI ELCOUR
  282. CALL INILRF('H1D2CU27','CUBE','LAGRANGE','H1',
  283. $ 3,27,27,2,
  284. $ ELCOUR,
  285. $ IMPR,IRET)
  286. IF (IRET.NE.0) GOTO 9999
  287. CALL FILRF('H1D2QU9',MYLRFS,ELPRO1,IMPR,IRET)
  288. IF (IRET.NE.0) GOTO 9999
  289. CALL FILRF('H1D2SE3',MYLRFS,ELPRO2,IMPR,IRET)
  290. IF (IRET.NE.0) GOTO 9999
  291. CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
  292. IF (IRET.NE.0) GOTO 9999
  293. * Les ieme d.d.l sont aux noeuds j
  294. DO IDDL=1,8
  295. ELCOUR.NPQUAF(IDDL)=IDDL
  296. ENDDO
  297. ELCOUR.NPQUAF( 9)=25
  298. ELCOUR.NPQUAF(10)=9
  299. ELCOUR.NPQUAF(11)=21
  300. ELCOUR.NPQUAF(12)=10
  301. ELCOUR.NPQUAF(13)=22
  302. ELCOUR.NPQUAF(14)=11
  303. ELCOUR.NPQUAF(15)=23
  304. ELCOUR.NPQUAF(16)=12
  305. ELCOUR.NPQUAF(17)=24
  306. ELCOUR.NPQUAF(18)=27
  307. DO IDDL=19,26
  308. ELCOUR.NPQUAF(IDDL)=IDDL-6
  309. ENDDO
  310. ELCOUR.NPQUAF(27)=26
  311. DO IDDL=1,27
  312. ELCOUR.NUMCMP(IDDL)=1
  313. ENDDO
  314. * Initialise la correspondance ddl-noeud+ord.der
  315. CALL INILAG(ELCOUR,IMPR,IRET)
  316. IF (IRET.NE.0) GOTO 9999
  317. SEGACT ELPRO1
  318. MYBPO1=ELPRO1.MBPOLY
  319. SEGDES ELPRO1
  320. SEGACT ELPRO2
  321. MYBPO2=ELPRO2.MBPOLY
  322. SEGDES ELPRO2
  323. * Calcule la base polynômiale produit
  324. CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
  325. IF (IRET.NE.0) GOTO 9999
  326. ELCOUR.MBPOLY=MYBPOL
  327. SEGDES ELCOUR
  328. MYLRFS.LISEL(**)=ELCOUR
  329. *
  330. * Normal termination
  331. *
  332. IRET=0
  333. RETURN
  334. *
  335. * Format handling
  336. *
  337. *
  338. * Error handling
  339. *
  340. 9999 CONTINUE
  341. IRET=1
  342. WRITE(IOIMP,*) 'An error was detected in subroutine inelcu'
  343. RETURN
  344. *
  345. * End of subroutine INELCU
  346. *
  347. END
  348.  
  349.  
  350.  
  351.  
  352.  

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