Télécharger la plaquette Cast3M


fr en

Télécharger infals.eso

Retour à la liste

Numérotation des lignes : 

infals

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

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