Télécharger la plaquette Cast3M


fr en

Télécharger inelqu.eso

Retour à la liste

Numérotation des lignes : 

inelqu

  1. C INELQU    SOURCE    GOUNAND   21/06/02    21:16:29     11022          
  2.       SUBROUTINE INELQU(MYLRFS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INELQU
  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 géométrique carrée.
  11. C
  12. C REFERENCES  :
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES          : INILRF, INILAG, GBAPCO, PROBAP
  18. C APPELE PAR       : INLRFS
  19. C***********************************************************************
  20. C ENTREES            : -
  21. C ENTREES/SORTIES    : MYLRFS
  22. C SORTIES            : -
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION    : v1, 23/03/00, version initiale
  26. C HISTORIQUE : v1, 23/03/00, création
  27. C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC TNLIN      
  39. *-INC SELREF
  40.       POINTEUR MYLRFS.ELREFS
  41.       POINTEUR ELCOUR.ELREF
  42. *-INC SPOLYNO
  43.       POINTEUR MYBPOL.POLYNS
  44.       POINTEUR MBPTMP.POLYNS
  45.       INTEGER NBMON,NDIML
  46.       POINTEUR MYPOL.POLYNO
  47. *
  48.       INTEGER IMPR,IRET
  49. * Elément de nom : L2D0QU1
  50.       REAL*8 ZERO
  51.       PARAMETER (ZERO=0.D0)
  52. * Elément de nom : L2D1QU3
  53.       REAL*8 UNS2
  54.       PARAMETER (UNS2=0.5D0)
  55. * Elément de nom : H1D1QU4
  56.       REAL*8 UN
  57.       PARAMETER (UN=1.D0)
  58. *
  59.       INTEGER INDDL
  60. *
  61. * Executable statements
  62. *
  63.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelqu'
  64. *
  65. * Elément de nom : L2D0QU1
  66. * Sur un carré : élément de Lagrange, fonction L2, approximation
  67. *   nodale, espace de référence de dimension 2, 1 noeud, 1 degré de
  68. *   liberté, degré de l'approximation : 0
  69. *
  70. * In INILRF : SEGINI ELCOUR
  71.       CALL INILRF('L2D0QU1','CARRE','LAGRANGE','L2',
  72.      $     2,1,1,0,
  73.      $     ELCOUR,
  74.      $     IMPR,IRET)
  75.       IF (IRET.NE.0) GOTO 9999
  76.       ELCOUR.XCONOD(1,1)=ZERO
  77.       ELCOUR.XCONOD(2,1)=ZERO
  78.       ELCOUR.NPQUAF(1)=9
  79.       ELCOUR.NUMCMP(1)=1
  80. * Initialise la correspondance ddl-noeud+ord.der
  81.       CALL INILAG(ELCOUR,IMPR,IRET)
  82.       IF (IRET.NE.0) GOTO 9999
  83. * Génère une base polynômiale complète (dimension 2, degré 0)
  84.       CALL GBAPCO(2,0,MYBPOL,IMPR,IRET)
  85.       IF (IRET.NE.0) GOTO 9999
  86.       ELCOUR.MBPOLY=MYBPOL
  87.       SEGDES ELCOUR
  88.       MYLRFS.LISEL(**)=ELCOUR
  89. *
  90. * Elément de nom : L2D1QU3
  91. * Sur un carré : élément de Lagrange, fonction L2, approximation
  92. *   nodale, espace de référence de dimension 2, 3 noeuds, 3 degrés de
  93. *   liberté, degré de l'approximation : 1
  94. *
  95. * In INILRF : SEGINI ELCOUR
  96.       CALL INILRF('L2D1QU3','CARRE','LAGRANGE','L2',
  97.      $     2,3,3,1,
  98.      $     ELCOUR,
  99.      $     IMPR,IRET)
  100.       IF (IRET.NE.0) GOTO 9999
  101.       ELCOUR.XCONOD(1,1)=UNS2
  102.       ELCOUR.XCONOD(2,1)=UNS2
  103.       ELCOUR.XCONOD(1,2)=-UNS2
  104.       ELCOUR.XCONOD(2,2)=ZERO
  105.       ELCOUR.XCONOD(1,3)=ZERO
  106.       ELCOUR.XCONOD(2,3)=-UNS2
  107.       ELCOUR.NPQUAF(1)=9
  108.       ELCOUR.NUMCMP(1)=1
  109.       ELCOUR.NPQUAF(2)=9
  110.       ELCOUR.NUMCMP(2)=2
  111.       ELCOUR.NPQUAF(3)=9
  112.       ELCOUR.NUMCMP(3)=3
  113. * Initialise la correspondance ddl-noeud+ord.der
  114.       CALL INILAG(ELCOUR,IMPR,IRET)
  115.       IF (IRET.NE.0) GOTO 9999
  116. * Génère une base polynômiale complète (dimension 2, degré 1)
  117.       CALL GBAPCO(2,1,MYBPOL,IMPR,IRET)
  118.       IF (IRET.NE.0) GOTO 9999
  119.       ELCOUR.MBPOLY=MYBPOL
  120.       SEGDES ELCOUR
  121.       MYLRFS.LISEL(**)=ELCOUR
  122. *
  123. * Elément de nom : H1D1QU4
  124. * Sur un carré : élément de Lagrange, fonction H1, approximation
  125. *   nodale, espace de référence de dimension 2, 4 noeuds, 4 degrés de
  126. *   liberté, degré de l'approximation : 1
  127. *
  128. * In INILRF : SEGINI ELCOUR
  129.       CALL INILRF('H1D1QU4','CARRE','LAGRANGE','H1',
  130.      $     2,4,4,1,
  131.      $     ELCOUR,
  132.      $     IMPR,IRET)
  133.       IF (IRET.NE.0) GOTO 9999
  134.       ELCOUR.XCONOD(1,1)=-UN
  135.       ELCOUR.XCONOD(2,1)=-UN
  136.       ELCOUR.XCONOD(1,2)=UN
  137.       ELCOUR.XCONOD(2,2)=-UN
  138.       ELCOUR.XCONOD(1,3)=UN
  139.       ELCOUR.XCONOD(2,3)=UN
  140.       ELCOUR.XCONOD(1,4)=-UN
  141.       ELCOUR.XCONOD(2,4)=UN
  142. * Les d.d.l. sont aux noeuds 1,3,5,7
  143.       DO 203 INDDL=1,4
  144.          ELCOUR.NPQUAF(INDDL)=(2*INDDL)-1
  145.          ELCOUR.NUMCMP(INDDL)=1
  146.  203  CONTINUE
  147. * Initialise la correspondance ddl-noeud+ord.der
  148.       CALL INILAG(ELCOUR,IMPR,IRET)
  149.       IF (IRET.NE.0) GOTO 9999
  150. * Génère une base polynômiale complète (dimension 1, degré 1)
  151. * In GBAPCO : SEGINI MBPTMP.LIPOLY(*)
  152.       CALL GBAPCO(1,1,MBPTMP,IMPR,IRET)
  153.       IF (IRET.NE.0) GOTO 9999
  154. * Puis la base produit
  155.       CALL PROBAP(MBPTMP,MBPTMP,MYBPOL,IMPR,IRET)
  156.       IF (IRET.NE.0) GOTO 9999
  157.       SEGACT MBPTMP*MOD
  158.       SEGSUP MBPTMP.LIPOLY(*)
  159.       SEGSUP MBPTMP
  160.       ELCOUR.MBPOLY=MYBPOL
  161.       SEGDES ELCOUR
  162.       MYLRFS.LISEL(**)=ELCOUR
  163. *
  164. * Elément de nom : CRD1QU4
  165. * Sur un carré : élément de Lagrange, fonction continue au centre
  166. * des faces, approximation
  167. *   nodale, espace de référence de dimension 2, 4 noeuds, 4 degrés de
  168. *   liberté, degré de l'approximation : 1
  169. *
  170. * In INILRF : SEGINI ELCOUR
  171.       CALL INILRF('CRD1QU4','CARRE','LAGRANGE','HFAC',
  172.      $     2,4,4,1,
  173.      $     ELCOUR,
  174.      $     IMPR,IRET)
  175.       IF (IRET.NE.0) GOTO 9999
  176.       ELCOUR.XCONOD(1,1)=ZERO
  177.       ELCOUR.XCONOD(2,1)=-UN
  178.       ELCOUR.XCONOD(1,2)=UN
  179.       ELCOUR.XCONOD(2,2)=ZERO
  180.       ELCOUR.XCONOD(1,3)=ZERO
  181.       ELCOUR.XCONOD(2,3)=UN
  182.       ELCOUR.XCONOD(1,4)=-UN
  183.       ELCOUR.XCONOD(2,4)=ZERO
  184. * Les d.d.l. sont aux noeuds 2,4,6,8
  185.       DO INDDL=1,4
  186.          ELCOUR.NPQUAF(INDDL)=2*INDDL
  187.          ELCOUR.NUMCMP(INDDL)=1
  188.       ENDDO
  189. * Initialise la correspondance ddl-noeud+ord.der
  190.       CALL INILAG(ELCOUR,IMPR,IRET)
  191.       IF (IRET.NE.0) GOTO 9999
  192. * Génère une base polynômiale complète (dimension 2, degré 1)
  193.       CALL GBAPCO(2,1,MYBPOL,IMPR,IRET)
  194.       IF (IRET.NE.0) GOTO 9999
  195. * On rajoute les polynômes spécifiques à crouzeix-raviart quadrilatère
  196.       CALL GPOCRQ(2,MYBPOL,IMPR,IRET)
  197.       IF (IRET.NE.0) GOTO 9999
  198.       ELCOUR.MBPOLY=MYBPOL
  199.       SEGDES ELCOUR
  200.       MYLRFS.LISEL(**)=ELCOUR
  201. *
  202. * Elément de nom : H1D2QU9
  203. * Sur un carré : élément de Lagrange, fonction H1, approximation
  204. *   nodale, espace de référence de dimension 2, 9 noeuds, 9 degrés de
  205. *   liberté, degré de l'approximation : 2
  206. *
  207. * In INILRF : SEGINI ELCOUR
  208.       CALL INILRF('H1D2QU9','CARRE','LAGRANGE','H1',
  209.      $     2,9,9,2,
  210.      $     ELCOUR,
  211.      $     IMPR,IRET)
  212.       IF (IRET.NE.0) GOTO 9999
  213.       ELCOUR.XCONOD(1,1)=-UN
  214.       ELCOUR.XCONOD(2,1)=-UN
  215.       ELCOUR.XCONOD(1,2)=ZERO
  216.       ELCOUR.XCONOD(2,2)=-UN
  217.       ELCOUR.XCONOD(1,3)=UN
  218.       ELCOUR.XCONOD(2,3)=-UN
  219.       ELCOUR.XCONOD(1,4)=UN
  220.       ELCOUR.XCONOD(2,4)=ZERO
  221.       ELCOUR.XCONOD(1,5)=UN
  222.       ELCOUR.XCONOD(2,5)=UN
  223.       ELCOUR.XCONOD(1,6)=ZERO
  224.       ELCOUR.XCONOD(2,6)=UN
  225.       ELCOUR.XCONOD(1,7)=-UN
  226.       ELCOUR.XCONOD(2,7)=UN
  227.       ELCOUR.XCONOD(1,8)=-UN
  228.       ELCOUR.XCONOD(2,8)=ZERO
  229.       ELCOUR.XCONOD(1,9)=ZERO
  230.       ELCOUR.XCONOD(2,9)=ZERO
  231. * Les d.d.l. sont aux noeuds 1,2,3,4,5,6,7,8,9
  232.       DO 209 INDDL=1,9
  233.          ELCOUR.NPQUAF(INDDL)=INDDL
  234.          ELCOUR.NUMCMP(INDDL)=1
  235.  209  CONTINUE
  236. * Initialise la correspondance ddl-noeud+ord.der
  237.       CALL INILAG(ELCOUR,IMPR,IRET)
  238.       IF (IRET.NE.0) GOTO 9999
  239. * Génère une base polynômiale complète (dimension 1, degré 2)
  240. * In GBAPCO : SEGINI MBPTMP.LIPOLY(*)
  241.       CALL GBAPCO(1,2,MBPTMP,IMPR,IRET)
  242.       IF (IRET.NE.0) GOTO 9999
  243. * Puis la base produit
  244.       CALL PROBAP(MBPTMP,MBPTMP,MYBPOL,IMPR,IRET)
  245.       IF (IRET.NE.0) GOTO 9999
  246.       SEGACT MBPTMP*MOD
  247.       SEGSUP MBPTMP.LIPOLY(*)
  248.       SEGSUP MBPTMP
  249.       ELCOUR.MBPOLY=MYBPOL
  250.       SEGDES ELCOUR
  251.       MYLRFS.LISEL(**)=ELCOUR
  252. *
  253. * Elément de nom : H1D2QU8
  254. * Sur un carré : élément de Lagrange incomplet (Serendip),
  255. *   fonction H1, approximation nodale, espace de référence de dimension 2,
  256. *   8 noeuds, 8 degrés de liberté, degré de l'approximation : 2
  257. *
  258. * In INILRF : SEGINI ELCOUR
  259.       CALL INILRF('H1D2QU8','CARRE','LAGRANGE','H1',
  260.      $     2,8,8,2,
  261.      $     ELCOUR,
  262.      $     IMPR,IRET)
  263.       IF (IRET.NE.0) GOTO 9999
  264.       ELCOUR.XCONOD(1,1)=-UN
  265.       ELCOUR.XCONOD(2,1)=-UN
  266.       ELCOUR.XCONOD(1,2)=ZERO
  267.       ELCOUR.XCONOD(2,2)=-UN
  268.       ELCOUR.XCONOD(1,3)=UN
  269.       ELCOUR.XCONOD(2,3)=-UN
  270.       ELCOUR.XCONOD(1,4)=UN
  271.       ELCOUR.XCONOD(2,4)=ZERO
  272.       ELCOUR.XCONOD(1,5)=UN
  273.       ELCOUR.XCONOD(2,5)=UN
  274.       ELCOUR.XCONOD(1,6)=ZERO
  275.       ELCOUR.XCONOD(2,6)=UN
  276.       ELCOUR.XCONOD(1,7)=-UN
  277.       ELCOUR.XCONOD(2,7)=UN
  278.       ELCOUR.XCONOD(1,8)=-UN
  279.       ELCOUR.XCONOD(2,8)=ZERO
  280. * Les d.d.l. sont aux noeuds 1,2,3,4,5,6,7,8
  281.       DO 211 INDDL=1,8
  282.          ELCOUR.NPQUAF(INDDL)=INDDL
  283.          ELCOUR.NUMCMP(INDDL)=1
  284.  211  CONTINUE
  285. * Initialise la correspondance ddl-noeud+ord.der
  286.       CALL INILAG(ELCOUR,IMPR,IRET)
  287.       IF (IRET.NE.0) GOTO 9999
  288. * Génère une base polynômiale complète (dimension 2, degré 2)
  289.       CALL GBAPCO(2,2,MYBPOL,IMPR,IRET)
  290.       IF (IRET.NE.0) GOTO 9999
  291. * On rajoute (\ksi^2 \eta et \ksi \eta^2)
  292.       SEGACT MYBPOL*MOD
  293.       NDIML=2
  294.       NBMON=1
  295.       SEGINI MYPOL
  296.       MYPOL.COEMON(1)=UN
  297.       MYPOL.EXPMON(1,1)=2
  298.       MYPOL.EXPMON(2,1)=1
  299.       SEGDES MYPOL
  300.       MYBPOL.LIPOLY(**)=MYPOL
  301.       NDIML=2
  302.       NBMON=1
  303.       SEGINI MYPOL
  304.       MYPOL.COEMON(1)=UN
  305.       MYPOL.EXPMON(1,1)=1
  306.       MYPOL.EXPMON(2,1)=2
  307.       SEGDES MYPOL
  308.       MYBPOL.LIPOLY(**)=MYPOL
  309. * Voilà c'est fait
  310.       SEGDES MYBPOL
  311.       ELCOUR.MBPOLY=MYBPOL
  312.       SEGDES ELCOUR
  313.       MYLRFS.LISEL(**)=ELCOUR
  314. *
  315. * Normal termination
  316. *
  317.       IRET=0
  318.       RETURN
  319. *
  320. * Format handling
  321. *
  322. *
  323. * Error handling
  324. *
  325.  9999 CONTINUE
  326.       IRET=1
  327.       WRITE(IOIMP,*) 'An error was detected in subroutine inelqu'
  328.       RETURN
  329. *
  330. * End of subroutine INELQU
  331. *
  332.       END
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  

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