Télécharger infals.eso

Retour à la liste

Numérotation des lignes :

  1. C INFALS SOURCE GOUNAND 08/08/08 21:15:00 6142
  2. SUBROUTINE INFALS(MYFALS,MYLRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INFALS
  7. C PROJET : Noyau linéaire NLIN
  8. C DESCRIPTION : Initialise le segment contenant les informations sur
  9. C l'ensemble des familles d'éléments de référence
  10. C
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES : INIFAL, FILFAL, PRFAL (initialisations, impression)
  16. C APPELE PAR : PRNLI2
  17. C***********************************************************************
  18. C ENTREES : * MYLRFS (type ELREFS) : segment de description
  19. C des éléments de références.
  20. C ENTREES/SORTIES : -
  21. C SORTIES : * MYFALS (type FALRFS) : segment de description
  22. C des familles d'éléments de références.
  23. C TRAVAIL : * FACOUR (type FALRFS) : famille courante.
  24. C * NBDFA (type ENTIER) : nombre total de familles
  25. C d'éléments
  26. C * INBDFA (type ENTIER) : indice de boucle sur les
  27. C familles d'éléments
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION : v1, 17/08/99, version initiale
  31. C HISTORIQUE : v1, 17/08/99, création
  32. C HISTORIQUE : 26/07/02, ajout du triangle cubique
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. CBEGININCLUDE SELREF
  43. SEGMENT ELREF
  44. CHARACTER*(LNNOM) NOMLRF
  45. CHARACTER*(LNFORM) FORME
  46. CHARACTER*(LNTYPL) TYPEL
  47. CHARACTER*(LNESP) ESPACE
  48. INTEGER DEGRE
  49. REAL*8 XCONOD(NDIMEL,NBNOD)
  50. INTEGER NPQUAF(NBDDL)
  51. INTEGER NUMCMP(NBDDL)
  52. INTEGER QUENOD(NBDDL)
  53. INTEGER ORDDER(NDIMEL,NBDDL)
  54. POINTEUR MBPOLY.POLYNS
  55. ENDSEGMENT
  56. SEGMENT ELREFS
  57. POINTEUR LISEL(0).ELREF
  58. ENDSEGMENT
  59. CENDINCLUDE SELREF
  60. POINTEUR MYLRFS.ELREFS
  61. CBEGININCLUDE SFALRF
  62. SEGMENT FALRF
  63. CHARACTER*(LNNFA) NOMFA
  64. INTEGER NUQUAF(NBLRF)
  65. POINTEUR ELEMF(NBLRF).ELREF
  66. ENDSEGMENT
  67. SEGMENT FALRFS
  68. POINTEUR LISFA(0).FALRF
  69. ENDSEGMENT
  70. CENDINCLUDE SFALRF
  71. POINTEUR MYFALS.FALRFS
  72. POINTEUR FACOUR.FALRF
  73. *
  74. INTEGER IMPR,IRET
  75. *
  76. INTEGER NBDFA,INBDFA
  77. *
  78. * Executable statements
  79. *
  80. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans infals'
  81. SEGINI MYFALS
  82. *
  83. * Famille de nom : CSTE
  84. * Elément de Lagrange, fonctions L2, approximation nodale,
  85. * degré de l'approximation : 0
  86. * 7 éléments : segment, triangle, carré, tétraèdre, pyramide,
  87. * prisme, cube
  88. *
  89. * In INIFAL : SEGINI FACOUR
  90. CALL INIFAL('CSTE',
  91. $ FACOUR,
  92. $ IMPR,IRET)
  93. IF (IRET.NE.0) GOTO 9999
  94. CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET)
  95. IF (IRET.NE.0) GOTO 9999
  96. CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D0TR1',IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D0QU1',IMPR,IRET)
  99. IF (IRET.NE.0) GOTO 9999
  100. CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D0TE1',IMPR,IRET)
  101. IF (IRET.NE.0) GOTO 9999
  102. CALL FILFAL(FACOUR,MYLRFS,'PY19','L2D0PY1',IMPR,IRET)
  103. IF (IRET.NE.0) GOTO 9999
  104. CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D0PR1',IMPR,IRET)
  105. IF (IRET.NE.0) GOTO 9999
  106. CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D0CU1',IMPR,IRET)
  107. IF (IRET.NE.0) GOTO 9999
  108. SEGDES FACOUR
  109. MYFALS.LISFA(**)=FACOUR
  110. *
  111. * Famille de nom : LINM (linéaire par morceaux)
  112. * Elément de Lagrange, fonctions L2, approximation nodale,
  113. * degré de l'approximation : 1
  114. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  115. *
  116. * In INIFAL : SEGINI FACOUR
  117. CALL INIFAL('LINM',
  118. $ FACOUR,
  119. $ IMPR,IRET)
  120. IF (IRET.NE.0) GOTO 9999
  121. CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D1SE2',IMPR,IRET)
  122. IF (IRET.NE.0) GOTO 9999
  123. CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D1TR3',IMPR,IRET)
  124. IF (IRET.NE.0) GOTO 9999
  125. CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D1QU3',IMPR,IRET)
  126. IF (IRET.NE.0) GOTO 9999
  127. CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D1TE4',IMPR,IRET)
  128. IF (IRET.NE.0) GOTO 9999
  129. CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D1PR4',IMPR,IRET)
  130. IF (IRET.NE.0) GOTO 9999
  131. CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D1CU4',IMPR,IRET)
  132. IF (IRET.NE.0) GOTO 9999
  133. SEGDES FACOUR
  134. MYFALS.LISFA(**)=FACOUR
  135. *
  136. * Famille de nom : LINE
  137. * Elément de Lagrange, fonctions H1, approximation nodale,
  138. * degré de l'approximation : 1
  139. *
  140. *
  141. * In INIFAL : SEGINI FACOUR
  142. CALL INIFAL('LINE',
  143. $ FACOUR,
  144. $ IMPR,IRET)
  145. IF (IRET.NE.0) GOTO 9999
  146. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET)
  147. IF (IRET.NE.0) GOTO 9999
  148. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR3',IMPR,IRET)
  149. IF (IRET.NE.0) GOTO 9999
  150. CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D1QU4',IMPR,IRET)
  151. IF (IRET.NE.0) GOTO 9999
  152. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE4',IMPR,IRET)
  153. IF (IRET.NE.0) GOTO 9999
  154. CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D1PY5',IMPR,IRET)
  155. IF (IRET.NE.0) GOTO 9999
  156. CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D1PR6',IMPR,IRET)
  157. IF (IRET.NE.0) GOTO 9999
  158. CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D1CU8',IMPR,IRET)
  159. IF (IRET.NE.0) GOTO 9999
  160. SEGDES FACOUR
  161. MYFALS.LISFA(**)=FACOUR
  162. *
  163. * Famille de nom : LINC
  164. * Elément de Lagrange, type Crouzeix-Raviart, approximation nodale,
  165. * degré de l'approximation : 1
  166. *
  167. *
  168. * In INIFAL : SEGINI FACOUR
  169. CALL INIFAL('LINC',
  170. $ FACOUR,
  171. $ IMPR,IRET)
  172. IF (IRET.NE.0) GOTO 9999
  173. * CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET)
  174. CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET)
  175. IF (IRET.NE.0) GOTO 9999
  176. CALL FILFAL(FACOUR,MYLRFS,'TRI7','CRD1TR3',IMPR,IRET)
  177. IF (IRET.NE.0) GOTO 9999
  178. CALL FILFAL(FACOUR,MYLRFS,'QUA9','CRD1QU4',IMPR,IRET)
  179. IF (IRET.NE.0) GOTO 9999
  180. CALL FILFAL(FACOUR,MYLRFS,'TE15','CRD1TE4',IMPR,IRET)
  181. IF (IRET.NE.0) GOTO 9999
  182. *
  183. * La pyramide doit être facile à faire, les fonctions de forme
  184. * sont les mêmes que celles de la famille H1.
  185. * Mais cet élément marche-t-il ? Jamais vu dans la littérature
  186. *
  187. * CALL FILFAL(FACOUR,MYLRFS,'PY19','CRD1PY5',IMPR,IRET)
  188. * IF (IRET.NE.0) GOTO 9999
  189. CALL FILFAL(FACOUR,MYLRFS,'PR21','CRD1PR5',IMPR,IRET)
  190. IF (IRET.NE.0) GOTO 9999
  191. CALL FILFAL(FACOUR,MYLRFS,'CU27','CRD1CU6',IMPR,IRET)
  192. IF (IRET.NE.0) GOTO 9999
  193. SEGDES FACOUR
  194. MYFALS.LISFA(**)=FACOUR
  195. *
  196. * Famille de nom : LINB
  197. * Elément de Lagrange simpliciaux + bulle,
  198. * fonctions H1, approximation nodale,
  199. * degré de l'approximation : 1
  200. *
  201. * In INIFAL : SEGINI FACOUR
  202. CALL INIFAL('LINB',
  203. $ FACOUR,
  204. $ IMPR,IRET)
  205. IF (IRET.NE.0) GOTO 9999
  206. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET)
  207. IF (IRET.NE.0) GOTO 9999
  208. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR4',IMPR,IRET)
  209. IF (IRET.NE.0) GOTO 9999
  210. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE5',IMPR,IRET)
  211. IF (IRET.NE.0) GOTO 9999
  212. SEGDES FACOUR
  213. MYFALS.LISFA(**)=FACOUR
  214. *
  215. * Famille de nom : QUAI
  216. * Elément de Lagrange incomplets, fonctions H1, approximation nodale,
  217. * degré de l'approximation : 2
  218. *
  219. * In INIFAL : SEGINI FACOUR
  220. CALL INIFAL('QUAI',
  221. $ FACOUR,
  222. $ IMPR,IRET)
  223. IF (IRET.NE.0) GOTO 9999
  224. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET)
  225. IF (IRET.NE.0) GOTO 9999
  226. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET)
  227. IF (IRET.NE.0) GOTO 9999
  228. CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU8',IMPR,IRET)
  229. IF (IRET.NE.0) GOTO 9999
  230. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET)
  231. IF (IRET.NE.0) GOTO 9999
  232. CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D2PY13',IMPR,IRET)
  233. IF (IRET.NE.0) GOTO 9999
  234. CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR15',IMPR,IRET)
  235. IF (IRET.NE.0) GOTO 9999
  236. CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU20',IMPR,IRET)
  237. IF (IRET.NE.0) GOTO 9999
  238. SEGDES FACOUR
  239. MYFALS.LISFA(**)=FACOUR
  240. *
  241. * Famille de nom : QUAD
  242. * Elément de Lagrange, fonctions H1, approximation nodale,
  243. * degré de l'approximation : 2
  244. *
  245. * In INIFAL : SEGINI FACOUR
  246. CALL INIFAL('QUAD',
  247. $ FACOUR,
  248. $ IMPR,IRET)
  249. IF (IRET.NE.0) GOTO 9999
  250. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET)
  251. IF (IRET.NE.0) GOTO 9999
  252. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET)
  253. IF (IRET.NE.0) GOTO 9999
  254. CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET)
  255. IF (IRET.NE.0) GOTO 9999
  256. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET)
  257. IF (IRET.NE.0) GOTO 9999
  258. CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR18',IMPR,IRET)
  259. IF (IRET.NE.0) GOTO 9999
  260. CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET)
  261. IF (IRET.NE.0) GOTO 9999
  262. SEGDES FACOUR
  263. MYFALS.LISFA(**)=FACOUR
  264. *
  265. * Famille de nom : QUAF (Quadratique pour les fluides)
  266. * Elément de Lagrange + bulles éventuelles, fonctions H1, approximation
  267. * nodale, degré de l'approximation : 2
  268. *
  269. * In INIFAL : SEGINI FACOUR
  270. CALL INIFAL('QUAF',
  271. $ FACOUR,
  272. $ IMPR,IRET)
  273. IF (IRET.NE.0) GOTO 9999
  274. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET)
  275. IF (IRET.NE.0) GOTO 9999
  276. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR7',IMPR,IRET)
  277. IF (IRET.NE.0) GOTO 9999
  278. CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET)
  279. IF (IRET.NE.0) GOTO 9999
  280. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE15',IMPR,IRET)
  281. IF (IRET.NE.0) GOTO 9999
  282. CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR21',IMPR,IRET)
  283. IF (IRET.NE.0) GOTO 9999
  284. CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET)
  285. IF (IRET.NE.0) GOTO 9999
  286. SEGDES FACOUR
  287. MYFALS.LISFA(**)=FACOUR
  288. *
  289. * Famille de nom : CUBI
  290. * Elément de Lagrange, fonctions H1, approximation nodale,
  291. * degré de l'approximation : 3
  292. *
  293. * In INIFAL : SEGINI FACOUR
  294. CALL INIFAL('CUBI',
  295. $ FACOUR,
  296. $ IMPR,IRET)
  297. IF (IRET.NE.0) GOTO 9999
  298. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D3TR10',IMPR,IRET)
  299. IF (IRET.NE.0) GOTO 9999
  300. SEGDES FACOUR
  301. MYFALS.LISFA(**)=FACOUR
  302. *
  303. * Famille de nom : BULL
  304. * Elément de Lagrange simpliciaux bulle,
  305. * fonctions H10, approximation nodale,
  306. * degré de l'approximation : 0
  307. *
  308. * In INIFAL : SEGINI FACOUR
  309. CALL INIFAL('BULL',
  310. $ FACOUR,
  311. $ IMPR,IRET)
  312. IF (IRET.NE.0) GOTO 9999
  313. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H10D0TR1',IMPR,IRET)
  314. IF (IRET.NE.0) GOTO 9999
  315. SEGDES FACOUR
  316. MYFALS.LISFA(**)=FACOUR
  317. *
  318. * Impression finale
  319. *
  320. NBDFA=MYFALS.LISFA(/1)
  321. IF (IMPR.GT.1) THEN
  322. DO 3 INBDFA=1,NBDFA
  323. WRITE(IOIMP,*) 'Famille d''éléments de référence ',INBDFA
  324. FACOUR=MYFALS.LISFA(INBDFA)
  325. CALL PRFAL(FACOUR,IMPR,IRET)
  326. IF (IRET.NE.0) GOTO 9999
  327. 3 CONTINUE
  328. ENDIF
  329. SEGDES MYFALS
  330. *
  331. * Normal termination
  332. *
  333. IRET=0
  334. RETURN
  335. *
  336. * Format handling
  337. *
  338. *
  339. * Error handling
  340. *
  341. 9999 CONTINUE
  342. IRET=1
  343. WRITE(IOIMP,*) 'An error was detected in subroutine infals'
  344. RETURN
  345. *
  346. * End of subroutine INFALS
  347. *
  348. END
  349.  
  350.  
  351.  
  352.  
  353.  

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