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. -INC CCOPTIO
  40. CBEGININCLUDE SELREF
  41. SEGMENT ELREF
  42. CHARACTER*(LNNOM) NOMLRF
  43. CHARACTER*(LNFORM) FORME
  44. CHARACTER*(LNTYPL) TYPEL
  45. CHARACTER*(LNESP) ESPACE
  46. INTEGER DEGRE
  47. REAL*8 XCONOD(NDIMEL,NBNOD)
  48. INTEGER NPQUAF(NBDDL)
  49. INTEGER NUMCMP(NBDDL)
  50. INTEGER QUENOD(NBDDL)
  51. INTEGER ORDDER(NDIMEL,NBDDL)
  52. POINTEUR MBPOLY.POLYNS
  53. ENDSEGMENT
  54. SEGMENT ELREFS
  55. POINTEUR LISEL(0).ELREF
  56. ENDSEGMENT
  57. CENDINCLUDE SELREF
  58. POINTEUR MYLRFS.ELREFS
  59. CBEGININCLUDE SFALRF
  60. SEGMENT FALRF
  61. CHARACTER*(LNNFA) NOMFA
  62. INTEGER NUQUAF(NBLRF)
  63. POINTEUR ELEMF(NBLRF).ELREF
  64. ENDSEGMENT
  65. SEGMENT FALRFS
  66. POINTEUR LISFA(0).FALRF
  67. ENDSEGMENT
  68. CENDINCLUDE SFALRF
  69. POINTEUR MYFALS.FALRFS
  70. POINTEUR FACOUR.FALRF
  71. *
  72. INTEGER IMPR,IRET
  73. *
  74. INTEGER NBDFA,INBDFA
  75. *
  76. * Executable statements
  77. *
  78. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans infals'
  79. SEGINI MYFALS
  80. *
  81. * Famille de nom : CSTE
  82. * Elément de Lagrange, fonctions L2, approximation nodale,
  83. * degré de l'approximation : 0
  84. * 7 éléments : segment, triangle, carré, tétraèdre, pyramide,
  85. * prisme, cube
  86. *
  87. * In INIFAL : SEGINI FACOUR
  88. CALL INIFAL('CSTE',
  89. $ FACOUR,
  90. $ IMPR,IRET)
  91. IF (IRET.NE.0) GOTO 9999
  92. CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET)
  93. IF (IRET.NE.0) GOTO 9999
  94. CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D0TR1',IMPR,IRET)
  95. IF (IRET.NE.0) GOTO 9999
  96. CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D0QU1',IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D0TE1',IMPR,IRET)
  99. IF (IRET.NE.0) GOTO 9999
  100. CALL FILFAL(FACOUR,MYLRFS,'PY19','L2D0PY1',IMPR,IRET)
  101. IF (IRET.NE.0) GOTO 9999
  102. CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D0PR1',IMPR,IRET)
  103. IF (IRET.NE.0) GOTO 9999
  104. CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D0CU1',IMPR,IRET)
  105. IF (IRET.NE.0) GOTO 9999
  106. SEGDES FACOUR
  107. MYFALS.LISFA(**)=FACOUR
  108. *
  109. * Famille de nom : LINM (linéaire par morceaux)
  110. * Elément de Lagrange, fonctions L2, approximation nodale,
  111. * degré de l'approximation : 1
  112. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  113. *
  114. * In INIFAL : SEGINI FACOUR
  115. CALL INIFAL('LINM',
  116. $ FACOUR,
  117. $ IMPR,IRET)
  118. IF (IRET.NE.0) GOTO 9999
  119. CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D1SE2',IMPR,IRET)
  120. IF (IRET.NE.0) GOTO 9999
  121. CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D1TR3',IMPR,IRET)
  122. IF (IRET.NE.0) GOTO 9999
  123. CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D1QU3',IMPR,IRET)
  124. IF (IRET.NE.0) GOTO 9999
  125. CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D1TE4',IMPR,IRET)
  126. IF (IRET.NE.0) GOTO 9999
  127. CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D1PR4',IMPR,IRET)
  128. IF (IRET.NE.0) GOTO 9999
  129. CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D1CU4',IMPR,IRET)
  130. IF (IRET.NE.0) GOTO 9999
  131. SEGDES FACOUR
  132. MYFALS.LISFA(**)=FACOUR
  133. *
  134. * Famille de nom : LINE
  135. * Elément de Lagrange, fonctions H1, approximation nodale,
  136. * degré de l'approximation : 1
  137. *
  138. *
  139. * In INIFAL : SEGINI FACOUR
  140. CALL INIFAL('LINE',
  141. $ FACOUR,
  142. $ IMPR,IRET)
  143. IF (IRET.NE.0) GOTO 9999
  144. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET)
  145. IF (IRET.NE.0) GOTO 9999
  146. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR3',IMPR,IRET)
  147. IF (IRET.NE.0) GOTO 9999
  148. CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D1QU4',IMPR,IRET)
  149. IF (IRET.NE.0) GOTO 9999
  150. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE4',IMPR,IRET)
  151. IF (IRET.NE.0) GOTO 9999
  152. CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D1PY5',IMPR,IRET)
  153. IF (IRET.NE.0) GOTO 9999
  154. CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D1PR6',IMPR,IRET)
  155. IF (IRET.NE.0) GOTO 9999
  156. CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D1CU8',IMPR,IRET)
  157. IF (IRET.NE.0) GOTO 9999
  158. SEGDES FACOUR
  159. MYFALS.LISFA(**)=FACOUR
  160. *
  161. * Famille de nom : LINC
  162. * Elément de Lagrange, type Crouzeix-Raviart, approximation nodale,
  163. * degré de l'approximation : 1
  164. *
  165. *
  166. * In INIFAL : SEGINI FACOUR
  167. CALL INIFAL('LINC',
  168. $ FACOUR,
  169. $ IMPR,IRET)
  170. IF (IRET.NE.0) GOTO 9999
  171. * CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET)
  172. CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET)
  173. IF (IRET.NE.0) GOTO 9999
  174. CALL FILFAL(FACOUR,MYLRFS,'TRI7','CRD1TR3',IMPR,IRET)
  175. IF (IRET.NE.0) GOTO 9999
  176. CALL FILFAL(FACOUR,MYLRFS,'QUA9','CRD1QU4',IMPR,IRET)
  177. IF (IRET.NE.0) GOTO 9999
  178. CALL FILFAL(FACOUR,MYLRFS,'TE15','CRD1TE4',IMPR,IRET)
  179. IF (IRET.NE.0) GOTO 9999
  180. *
  181. * La pyramide doit être facile à faire, les fonctions de forme
  182. * sont les mêmes que celles de la famille H1.
  183. * Mais cet élément marche-t-il ? Jamais vu dans la littérature
  184. *
  185. * CALL FILFAL(FACOUR,MYLRFS,'PY19','CRD1PY5',IMPR,IRET)
  186. * IF (IRET.NE.0) GOTO 9999
  187. CALL FILFAL(FACOUR,MYLRFS,'PR21','CRD1PR5',IMPR,IRET)
  188. IF (IRET.NE.0) GOTO 9999
  189. CALL FILFAL(FACOUR,MYLRFS,'CU27','CRD1CU6',IMPR,IRET)
  190. IF (IRET.NE.0) GOTO 9999
  191. SEGDES FACOUR
  192. MYFALS.LISFA(**)=FACOUR
  193. *
  194. * Famille de nom : LINB
  195. * Elément de Lagrange simpliciaux + bulle,
  196. * fonctions H1, approximation nodale,
  197. * degré de l'approximation : 1
  198. *
  199. * In INIFAL : SEGINI FACOUR
  200. CALL INIFAL('LINB',
  201. $ FACOUR,
  202. $ IMPR,IRET)
  203. IF (IRET.NE.0) GOTO 9999
  204. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET)
  205. IF (IRET.NE.0) GOTO 9999
  206. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR4',IMPR,IRET)
  207. IF (IRET.NE.0) GOTO 9999
  208. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE5',IMPR,IRET)
  209. IF (IRET.NE.0) GOTO 9999
  210. SEGDES FACOUR
  211. MYFALS.LISFA(**)=FACOUR
  212. *
  213. * Famille de nom : QUAI
  214. * Elément de Lagrange incomplets, fonctions H1, approximation nodale,
  215. * degré de l'approximation : 2
  216. *
  217. * In INIFAL : SEGINI FACOUR
  218. CALL INIFAL('QUAI',
  219. $ FACOUR,
  220. $ IMPR,IRET)
  221. IF (IRET.NE.0) GOTO 9999
  222. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET)
  223. IF (IRET.NE.0) GOTO 9999
  224. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET)
  225. IF (IRET.NE.0) GOTO 9999
  226. CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU8',IMPR,IRET)
  227. IF (IRET.NE.0) GOTO 9999
  228. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET)
  229. IF (IRET.NE.0) GOTO 9999
  230. CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D2PY13',IMPR,IRET)
  231. IF (IRET.NE.0) GOTO 9999
  232. CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR15',IMPR,IRET)
  233. IF (IRET.NE.0) GOTO 9999
  234. CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU20',IMPR,IRET)
  235. IF (IRET.NE.0) GOTO 9999
  236. SEGDES FACOUR
  237. MYFALS.LISFA(**)=FACOUR
  238. *
  239. * Famille de nom : QUAD
  240. * Elément de Lagrange, fonctions H1, approximation nodale,
  241. * degré de l'approximation : 2
  242. *
  243. * In INIFAL : SEGINI FACOUR
  244. CALL INIFAL('QUAD',
  245. $ FACOUR,
  246. $ IMPR,IRET)
  247. IF (IRET.NE.0) GOTO 9999
  248. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET)
  249. IF (IRET.NE.0) GOTO 9999
  250. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET)
  251. IF (IRET.NE.0) GOTO 9999
  252. CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET)
  253. IF (IRET.NE.0) GOTO 9999
  254. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET)
  255. IF (IRET.NE.0) GOTO 9999
  256. CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR18',IMPR,IRET)
  257. IF (IRET.NE.0) GOTO 9999
  258. CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET)
  259. IF (IRET.NE.0) GOTO 9999
  260. SEGDES FACOUR
  261. MYFALS.LISFA(**)=FACOUR
  262. *
  263. * Famille de nom : QUAF (Quadratique pour les fluides)
  264. * Elément de Lagrange + bulles éventuelles, fonctions H1, approximation
  265. * nodale, degré de l'approximation : 2
  266. *
  267. * In INIFAL : SEGINI FACOUR
  268. CALL INIFAL('QUAF',
  269. $ FACOUR,
  270. $ IMPR,IRET)
  271. IF (IRET.NE.0) GOTO 9999
  272. CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET)
  273. IF (IRET.NE.0) GOTO 9999
  274. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR7',IMPR,IRET)
  275. IF (IRET.NE.0) GOTO 9999
  276. CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET)
  277. IF (IRET.NE.0) GOTO 9999
  278. CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE15',IMPR,IRET)
  279. IF (IRET.NE.0) GOTO 9999
  280. CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR21',IMPR,IRET)
  281. IF (IRET.NE.0) GOTO 9999
  282. CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET)
  283. IF (IRET.NE.0) GOTO 9999
  284. SEGDES FACOUR
  285. MYFALS.LISFA(**)=FACOUR
  286. *
  287. * Famille de nom : CUBI
  288. * Elément de Lagrange, fonctions H1, approximation nodale,
  289. * degré de l'approximation : 3
  290. *
  291. * In INIFAL : SEGINI FACOUR
  292. CALL INIFAL('CUBI',
  293. $ FACOUR,
  294. $ IMPR,IRET)
  295. IF (IRET.NE.0) GOTO 9999
  296. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D3TR10',IMPR,IRET)
  297. IF (IRET.NE.0) GOTO 9999
  298. SEGDES FACOUR
  299. MYFALS.LISFA(**)=FACOUR
  300. *
  301. * Famille de nom : BULL
  302. * Elément de Lagrange simpliciaux bulle,
  303. * fonctions H10, approximation nodale,
  304. * degré de l'approximation : 0
  305. *
  306. * In INIFAL : SEGINI FACOUR
  307. CALL INIFAL('BULL',
  308. $ FACOUR,
  309. $ IMPR,IRET)
  310. IF (IRET.NE.0) GOTO 9999
  311. CALL FILFAL(FACOUR,MYLRFS,'TRI7','H10D0TR1',IMPR,IRET)
  312. IF (IRET.NE.0) GOTO 9999
  313. SEGDES FACOUR
  314. MYFALS.LISFA(**)=FACOUR
  315. *
  316. * Impression finale
  317. *
  318. NBDFA=MYFALS.LISFA(/1)
  319. IF (IMPR.GT.1) THEN
  320. DO 3 INBDFA=1,NBDFA
  321. WRITE(IOIMP,*) 'Famille d''éléments de référence ',INBDFA
  322. FACOUR=MYFALS.LISFA(INBDFA)
  323. CALL PRFAL(FACOUR,IMPR,IRET)
  324. IF (IRET.NE.0) GOTO 9999
  325. 3 CONTINUE
  326. ENDIF
  327. SEGDES MYFALS
  328. *
  329. * Normal termination
  330. *
  331. IRET=0
  332. RETURN
  333. *
  334. * Format handling
  335. *
  336. *
  337. * Error handling
  338. *
  339. 9999 CONTINUE
  340. IRET=1
  341. WRITE(IOIMP,*) 'An error was detected in subroutine infals'
  342. RETURN
  343. *
  344. * End of subroutine INFALS
  345. *
  346. END
  347.  
  348.  
  349.  
  350.  
  351.  

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