Télécharger inelqu.eso

Retour à la liste

Numérotation des lignes :

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

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