Télécharger la plaquette Cast3M


fr en

Télécharger ineltr.eso

Retour à la liste

Numérotation des lignes : 

ineltr

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

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