Télécharger la plaquette Cast3M


fr en

Télécharger inelte.eso

Retour à la liste

Numérotation des lignes : 

inelte

  1. C INELTE    SOURCE    GOUNAND   21/06/02    21:16:31     11022          
  2.       SUBROUTINE INELTE(MYLRFS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INELTE
  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 tétraèdrique.
  11. C REFERENCES  :
  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, INILAG, GBAPCO, GPOBUL, GPOFBU
  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.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC TNLIN      
  38. *-INC SELREF
  39.       POINTEUR MYLRFS.ELREFS
  40.       POINTEUR ELCOUR.ELREF
  41. *-INC SPOLYNO
  42.       POINTEUR MYBPOL.POLYNS
  43. *
  44.       INTEGER IMPR,IRET
  45. * Elément de nom : L2D0TE1
  46.       REAL*8 UNS4
  47.       PARAMETER (UNS4=0.25D0)
  48. * Elément de nom : L2D1TE4
  49.       REAL*8 RAC3,TROS4
  50.       PARAMETER (RAC3=1.7320508075688772935274463415059D0)
  51.       PARAMETER (TROS4=0.75D0)
  52. * Elément de nom : H1D1TE4
  53.       REAL*8 ZERO,UN
  54.       PARAMETER (ZERO=0.D0,UN=1.D0)
  55. * Elément de nom : H1D2TE15
  56.       REAL*8 UNS2,UNS3
  57.       PARAMETER (UNS2=1.D0/2.D0,UNS3=1.D0/3.D0)
  58. *
  59.       INTEGER INDDL
  60. *
  61. * Executable statements
  62. *
  63.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelte'
  64. *
  65. * Elément de nom : L2D0TE1
  66. * Sur un triangle : élément de Lagrange, fonction L2, approximation
  67. *   nodale, espace de référence de dimension 3, 1 noeud, 1 degré de
  68. *   liberté, degré de l'approximation : 0
  69. *
  70. * In INILRF : SEGINI ELCOUR
  71.       CALL INILRF('L2D0TE1','TETRAEDRE','LAGRANGE','L2',
  72.      $     3,1,1,0,
  73.      $     ELCOUR,
  74.      $     IMPR,IRET)
  75.       IF (IRET.NE.0) GOTO 9999
  76.       ELCOUR.XCONOD(1,1)=UNS4
  77.       ELCOUR.XCONOD(2,1)=UNS4
  78.       ELCOUR.XCONOD(3,1)=UNS4
  79.       ELCOUR.NPQUAF(1)=15
  80.       ELCOUR.NUMCMP(1)=1
  81. * Initialise la correspondance ddl-noeud+ord.der
  82.       CALL INILAG(ELCOUR,IMPR,IRET)
  83.       IF (IRET.NE.0) GOTO 9999
  84. * Génère une base polynômiale complète (dimension 3, degré 0)
  85.       CALL GBAPCO(3,0,MYBPOL,IMPR,IRET)
  86.       IF (IRET.NE.0) GOTO 9999
  87.       ELCOUR.MBPOLY=MYBPOL
  88.       SEGDES ELCOUR
  89.       MYLRFS.LISEL(**)=ELCOUR
  90. *
  91. * Elément de nom : L2D1TE4
  92. * Sur un tétraèdre : élément de Lagrange, fonction L2, approximation
  93. *   nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de
  94. *   liberté, degré de l'approximation : 1
  95. *
  96. * In INILRF : SEGINI ELCOUR
  97.       CALL INILRF('L2D1TE4','TETRAEDRE','LAGRANGE','L2',
  98.      $     3,4,4,1,
  99.      $     ELCOUR,
  100.      $     IMPR,IRET)
  101.       IF (IRET.NE.0) GOTO 9999
  102.       ELCOUR.XCONOD(1,1)=RAC3*UNS4
  103.       ELCOUR.XCONOD(2,1)=RAC3*UNS4
  104.       ELCOUR.XCONOD(3,1)=UNS4
  105.       ELCOUR.XCONOD(1,2)=RAC3*TROS4
  106.       ELCOUR.XCONOD(2,2)=RAC3*UNS4
  107.       ELCOUR.XCONOD(3,2)=UNS4
  108.       ELCOUR.XCONOD(1,3)=RAC3*TROS4
  109.       ELCOUR.XCONOD(2,3)=RAC3*TROS4
  110.       ELCOUR.XCONOD(3,3)=UNS4
  111.       ELCOUR.XCONOD(1,4)=RAC3*UNS4
  112.       ELCOUR.XCONOD(2,4)=RAC3*UNS4
  113.       ELCOUR.XCONOD(3,4)=TROS4
  114.       ELCOUR.NPQUAF(1)=15
  115.       ELCOUR.NUMCMP(1)=1
  116.       ELCOUR.NPQUAF(2)=15
  117.       ELCOUR.NUMCMP(2)=2
  118.       ELCOUR.NPQUAF(3)=15
  119.       ELCOUR.NUMCMP(3)=3
  120.       ELCOUR.NPQUAF(4)=15
  121.       ELCOUR.NUMCMP(4)=4
  122. * Initialise la correspondance ddl-noeud+ord.der
  123.       CALL INILAG(ELCOUR,IMPR,IRET)
  124.       IF (IRET.NE.0) GOTO 9999
  125. * Génère une base polynômiale complète (dimension 3, degré 1)
  126.       CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  127.       IF (IRET.NE.0) GOTO 9999
  128.       ELCOUR.MBPOLY=MYBPOL
  129.       SEGDES ELCOUR
  130.       MYLRFS.LISEL(**)=ELCOUR
  131. *
  132. * Elément de nom : H1D1TE4
  133. * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation
  134. *   nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de
  135. *   liberté, degré de l'approximation : 1, degré du polynôme
  136. *   d'interpolation 1
  137. *
  138. * In INILRF : SEGINI ELCOUR
  139.       CALL INILRF('H1D1TE4','TETRAEDRE','LAGRANGE','H1',
  140.      $     3,4,4,1,
  141.      $     ELCOUR,
  142.      $     IMPR,IRET)
  143.       IF (IRET.NE.0) GOTO 9999
  144.       ELCOUR.XCONOD(1,1)=ZERO
  145.       ELCOUR.XCONOD(2,1)=ZERO
  146.       ELCOUR.XCONOD(3,1)=ZERO
  147.       ELCOUR.XCONOD(1,2)=UN
  148.       ELCOUR.XCONOD(2,2)=ZERO
  149.       ELCOUR.XCONOD(3,2)=ZERO
  150.       ELCOUR.XCONOD(1,3)=ZERO
  151.       ELCOUR.XCONOD(2,3)=UN
  152.       ELCOUR.XCONOD(3,3)=ZERO
  153.       ELCOUR.XCONOD(1,4)=ZERO
  154.       ELCOUR.XCONOD(2,4)=ZERO
  155.       ELCOUR.XCONOD(3,4)=UN
  156. * Les d.d.l. sont aux noeuds 1,3,5,10
  157.       ELCOUR.NPQUAF(1)=1
  158.       ELCOUR.NPQUAF(2)=3
  159.       ELCOUR.NPQUAF(3)=5
  160.       ELCOUR.NPQUAF(4)=10
  161.       DO 213 INDDL=1,4
  162.          ELCOUR.NUMCMP(INDDL)=1
  163.  213  CONTINUE
  164. * Initialise la correspondance ddl-noeud+ord.der
  165.       CALL INILAG(ELCOUR,IMPR,IRET)
  166.       IF (IRET.NE.0) GOTO 9999
  167. * Génère une base polynômiale complète (dimension 3, degré 1)
  168.       CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  169.       IF (IRET.NE.0) GOTO 9999
  170.       ELCOUR.MBPOLY=MYBPOL
  171.       SEGDES ELCOUR
  172.       MYLRFS.LISEL(**)=ELCOUR
  173. *
  174. * Elément de nom : CRD1TE4
  175. * Sur un tétraèdre : élément de Lagrange, fonction continue au centre
  176. * des faces, approximation
  177. *   nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de
  178. *   liberté, degré de l'approximation : 1, degré du polynôme
  179. *   d'interpolation 1
  180. *
  181. * In INILRF : SEGINI ELCOUR
  182.       CALL INILRF('CRD1TE4','TETRAEDRE','LAGRANGE','H1',
  183.      $     3,4,4,1,
  184.      $     ELCOUR,
  185.      $     IMPR,IRET)
  186.       IF (IRET.NE.0) GOTO 9999
  187.       ELCOUR.XCONOD(1,1)=UNS3
  188.       ELCOUR.XCONOD(2,1)=UNS3
  189.       ELCOUR.XCONOD(3,1)=ZERO
  190.       ELCOUR.XCONOD(1,2)=UNS3
  191.       ELCOUR.XCONOD(2,2)=ZERO
  192.       ELCOUR.XCONOD(3,2)=UNS3
  193.       ELCOUR.XCONOD(1,3)=UNS3
  194.       ELCOUR.XCONOD(2,3)=UNS3
  195.       ELCOUR.XCONOD(3,3)=UNS3
  196.       ELCOUR.XCONOD(1,4)=ZERO
  197.       ELCOUR.XCONOD(2,4)=UNS3
  198.       ELCOUR.XCONOD(3,4)=UNS3
  199. * Les d.d.l. sont aux noeuds 11,12,13,14
  200.       DO INDDL=1,4
  201.          ELCOUR.NPQUAF(INDDL)=INDDL+10
  202.          ELCOUR.NUMCMP(INDDL)=1
  203.       ENDDO
  204. * Initialise la correspondance ddl-noeud+ord.der
  205.       CALL INILAG(ELCOUR,IMPR,IRET)
  206.       IF (IRET.NE.0) GOTO 9999
  207. * Génère une base polynômiale complète (dimension 3, degré 1)
  208.       CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  209.       IF (IRET.NE.0) GOTO 9999
  210.       ELCOUR.MBPOLY=MYBPOL
  211.       SEGDES ELCOUR
  212.       MYLRFS.LISEL(**)=ELCOUR
  213. *
  214. * Elément de nom : H1D1TE5
  215. * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation
  216. *   nodale, espace de référence de dimension 3, 5 noeuds, 5 degrés de
  217. *   liberté, degré de l'approximation : 1, degré du polynôme
  218. *   d'interpolation 3
  219. *
  220. * In INILRF : SEGINI ELCOUR
  221.       CALL INILRF('H1D1TE5','TETRAEDRE','LAGRANGE','H1',
  222.      $     3,5,5,1,
  223.      $     ELCOUR,
  224.      $     IMPR,IRET)
  225.       IF (IRET.NE.0) GOTO 9999
  226.       ELCOUR.XCONOD(1,1)=ZERO
  227.       ELCOUR.XCONOD(2,1)=ZERO
  228.       ELCOUR.XCONOD(3,1)=ZERO
  229.       ELCOUR.XCONOD(1,2)=UN
  230.       ELCOUR.XCONOD(2,2)=ZERO
  231.       ELCOUR.XCONOD(3,2)=ZERO
  232.       ELCOUR.XCONOD(1,3)=ZERO
  233.       ELCOUR.XCONOD(2,3)=UN
  234.       ELCOUR.XCONOD(3,3)=ZERO
  235.       ELCOUR.XCONOD(1,4)=ZERO
  236.       ELCOUR.XCONOD(2,4)=ZERO
  237.       ELCOUR.XCONOD(3,4)=UN
  238.       ELCOUR.XCONOD(1,5)=UNS4
  239.       ELCOUR.XCONOD(2,5)=UNS4
  240.       ELCOUR.XCONOD(3,5)=UNS4
  241. * Les d.d.l. sont aux noeuds 1,3,5,10,15
  242.       ELCOUR.NPQUAF(1)=1
  243.       ELCOUR.NPQUAF(2)=3
  244.       ELCOUR.NPQUAF(3)=5
  245.       ELCOUR.NPQUAF(4)=10
  246.       ELCOUR.NPQUAF(5)=15
  247.       DO 215 INDDL=1,5
  248.          ELCOUR.NUMCMP(INDDL)=1
  249.  215  CONTINUE
  250. * Initialise la correspondance ddl-noeud+ord.der
  251.       CALL INILAG(ELCOUR,IMPR,IRET)
  252.       IF (IRET.NE.0) GOTO 9999
  253. * Génère une base polynômiale complète (dimension 3, degré 1)
  254.       CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  255.       IF (IRET.NE.0) GOTO 9999
  256. * On rajoute la bulle (\ksi \eta \zeta \lambda avec
  257. *    \lambda=1-\ksi-\eta-\zeta)
  258.       CALL GPOBUL(3,MYBPOL,IMPR,IRET)
  259.       IF (IRET.NE.0) GOTO 9999
  260.       ELCOUR.MBPOLY=MYBPOL
  261.       SEGDES ELCOUR
  262.       MYLRFS.LISEL(**)=ELCOUR
  263. *
  264. * Elément de nom : H1D2TE10
  265. * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation
  266. *   nodale, espace de référence de dimension 3, 10 noeuds, 10 degrés de
  267. *   liberté, degré de l'approximation : 2, degré du polynôme
  268. *   d'interpolation 2
  269. *
  270. * In INILRF : SEGINI ELCOUR
  271.       CALL INILRF('H1D2TE10','TETRAEDRE','LAGRANGE','H1',
  272.      $     3,10,10,2,
  273.      $     ELCOUR,
  274.      $     IMPR,IRET)
  275.       IF (IRET.NE.0) GOTO 9999
  276.       ELCOUR.XCONOD(1,1)=ZERO
  277.       ELCOUR.XCONOD(2,1)=ZERO
  278.       ELCOUR.XCONOD(3,1)=ZERO
  279.       ELCOUR.XCONOD(1,2)=UNS2
  280.       ELCOUR.XCONOD(2,2)=ZERO
  281.       ELCOUR.XCONOD(3,2)=ZERO
  282.       ELCOUR.XCONOD(1,3)=UN
  283.       ELCOUR.XCONOD(2,3)=ZERO
  284.       ELCOUR.XCONOD(3,3)=ZERO
  285.       ELCOUR.XCONOD(1,4)=UNS2
  286.       ELCOUR.XCONOD(2,4)=UNS2
  287.       ELCOUR.XCONOD(3,4)=ZERO
  288.       ELCOUR.XCONOD(1,5)=ZERO
  289.       ELCOUR.XCONOD(2,5)=UN
  290.       ELCOUR.XCONOD(3,5)=ZERO
  291.       ELCOUR.XCONOD(1,6)=ZERO
  292.       ELCOUR.XCONOD(2,6)=UNS2
  293.       ELCOUR.XCONOD(3,6)=ZERO
  294.       ELCOUR.XCONOD(1,7)=ZERO
  295.       ELCOUR.XCONOD(2,7)=ZERO
  296.       ELCOUR.XCONOD(3,7)=UNS2
  297.       ELCOUR.XCONOD(1,8)=UNS2
  298.       ELCOUR.XCONOD(2,8)=ZERO
  299.       ELCOUR.XCONOD(3,8)=UNS2
  300.       ELCOUR.XCONOD(1,9)=ZERO
  301.       ELCOUR.XCONOD(2,9)=UNS2
  302.       ELCOUR.XCONOD(3,9)=UNS2
  303.       ELCOUR.XCONOD(1,10)=ZERO
  304.       ELCOUR.XCONOD(2,10)=ZERO
  305.       ELCOUR.XCONOD(3,10)=UN
  306. * Les d.d.l. sont aux noeuds 1,...,10
  307.       DO 217 INDDL=1,10
  308.          ELCOUR.NPQUAF(INDDL)=INDDL
  309.          ELCOUR.NUMCMP(INDDL)=1
  310.  217  CONTINUE
  311. * Initialise la correspondance ddl-noeud+ord.der
  312.       CALL INILAG(ELCOUR,IMPR,IRET)
  313.       IF (IRET.NE.0) GOTO 9999
  314. * Génère une base polynômiale complète (dimension 3, degré 2)
  315.       CALL GBAPCO(3,2,MYBPOL,IMPR,IRET)
  316.       IF (IRET.NE.0) GOTO 9999
  317.       ELCOUR.MBPOLY=MYBPOL
  318.       SEGDES ELCOUR
  319.       MYLRFS.LISEL(**)=ELCOUR
  320. *
  321. * Elément de nom : H1D2TE15
  322. * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation
  323. *   nodale, espace de référence de dimension 3, 15 noeuds, 15 degrés de
  324. *   liberté, degré de l'approximation : 2, degré du polynôme
  325. *   d'interpolation 4
  326. *
  327. * In INILRF : SEGINI ELCOUR
  328.       CALL INILRF('H1D2TE15','TETRAEDRE','LAGRANGE','H1',
  329.      $     3,15,15,2,
  330.      $     ELCOUR,
  331.      $     IMPR,IRET)
  332.       IF (IRET.NE.0) GOTO 9999
  333.       ELCOUR.XCONOD(1,1)=ZERO
  334.       ELCOUR.XCONOD(2,1)=ZERO
  335.       ELCOUR.XCONOD(3,1)=ZERO
  336.       ELCOUR.XCONOD(1,2)=UNS2
  337.       ELCOUR.XCONOD(2,2)=ZERO
  338.       ELCOUR.XCONOD(3,2)=ZERO
  339.       ELCOUR.XCONOD(1,3)=UN
  340.       ELCOUR.XCONOD(2,3)=ZERO
  341.       ELCOUR.XCONOD(3,3)=ZERO
  342.       ELCOUR.XCONOD(1,4)=UNS2
  343.       ELCOUR.XCONOD(2,4)=UNS2
  344.       ELCOUR.XCONOD(3,4)=ZERO
  345.       ELCOUR.XCONOD(1,5)=ZERO
  346.       ELCOUR.XCONOD(2,5)=UN
  347.       ELCOUR.XCONOD(3,5)=ZERO
  348.       ELCOUR.XCONOD(1,6)=ZERO
  349.       ELCOUR.XCONOD(2,6)=UNS2
  350.       ELCOUR.XCONOD(3,6)=ZERO
  351.       ELCOUR.XCONOD(1,7)=ZERO
  352.       ELCOUR.XCONOD(2,7)=ZERO
  353.       ELCOUR.XCONOD(3,7)=UNS2
  354.       ELCOUR.XCONOD(1,8)=UNS2
  355.       ELCOUR.XCONOD(2,8)=ZERO
  356.       ELCOUR.XCONOD(3,8)=UNS2
  357.       ELCOUR.XCONOD(1,9)=ZERO
  358.       ELCOUR.XCONOD(2,9)=UNS2
  359.       ELCOUR.XCONOD(3,9)=UNS2
  360.       ELCOUR.XCONOD(1,10)=ZERO
  361.       ELCOUR.XCONOD(2,10)=ZERO
  362.       ELCOUR.XCONOD(3,10)=UN
  363.       ELCOUR.XCONOD(1,11)=UNS3
  364.       ELCOUR.XCONOD(2,11)=UNS3
  365.       ELCOUR.XCONOD(3,11)=ZERO
  366.       ELCOUR.XCONOD(1,12)=UNS3
  367.       ELCOUR.XCONOD(2,12)=ZERO
  368.       ELCOUR.XCONOD(3,12)=UNS3
  369.       ELCOUR.XCONOD(1,13)=UNS3
  370.       ELCOUR.XCONOD(2,13)=UNS3
  371.       ELCOUR.XCONOD(3,13)=UNS3
  372.       ELCOUR.XCONOD(1,14)=ZERO
  373.       ELCOUR.XCONOD(2,14)=UNS3
  374.       ELCOUR.XCONOD(3,14)=UNS3
  375.       ELCOUR.XCONOD(1,15)=UNS4
  376.       ELCOUR.XCONOD(2,15)=UNS4
  377.       ELCOUR.XCONOD(3,15)=UNS4
  378. * Les d.d.l. sont aux noeuds 1,...,15
  379.       DO 219 INDDL=1,15
  380.          ELCOUR.NPQUAF(INDDL)=INDDL
  381.          ELCOUR.NUMCMP(INDDL)=1
  382.  219  CONTINUE
  383. * Initialise la correspondance ddl-noeud+ord.der
  384.       CALL INILAG(ELCOUR,IMPR,IRET)
  385.       IF (IRET.NE.0) GOTO 9999
  386. * Génère une base polynômiale complète (dimension 3, degré 2)
  387.       CALL GBAPCO(3,2,MYBPOL,IMPR,IRET)
  388.       IF (IRET.NE.0) GOTO 9999
  389. * On rajoute la bulle (\ksi \eta \zeta \lambda avec
  390. *    \lambda=1-\ksi-\eta-\zeta)
  391.       CALL GPOBUL(3,MYBPOL,IMPR,IRET)
  392.       IF (IRET.NE.0) GOTO 9999
  393. * On rajoute les 4 bulles aux faces (\ksi \eta \zeta \lambda avec
  394. *    \lambda=1-\ksi-\eta-\zeta)
  395.       CALL GPOFBU(3,MYBPOL,IMPR,IRET)
  396.       IF (IRET.NE.0) GOTO 9999
  397.       ELCOUR.MBPOLY=MYBPOL
  398.       SEGDES ELCOUR
  399.       MYLRFS.LISEL(**)=ELCOUR
  400. *
  401. * Normal termination
  402. *
  403.       IRET=0
  404.       RETURN
  405. *
  406. * Format handling
  407. *
  408. *
  409. * Error handling
  410. *
  411.  9999 CONTINUE
  412.       IRET=1
  413.       WRITE(IOIMP,*) 'An error was detected in subroutine inelte'
  414.       RETURN
  415. *
  416. * End of subroutine INELTE
  417. *
  418.       END
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  

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