Télécharger la plaquette Cast3M


fr en

Télécharger inelpr.eso

Retour à la liste

Numérotation des lignes : 

inelpr

  1. C INELPR    SOURCE    GOUNAND   21/06/02    21:16:27     11022          
  2.       SUBROUTINE INELPR(MYLRFS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INELPR
  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 géométrique prismatique à base triangle.
  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, FILRF, PROLRF, PROBAP, GBAPCO
  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. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC TNLIN      
  38. *-INC SELREF
  39.       POINTEUR MYLRFS.ELREFS
  40.       POINTEUR ELCOUR.ELREF
  41.       POINTEUR ELPRO1.ELREF
  42.       POINTEUR ELPRO2.ELREF
  43. *-INC SPOLYNO
  44.       POINTEUR MYBPOL.POLYNS
  45.       POINTEUR MYBPO1.POLYNS
  46.       POINTEUR MYBPO2.POLYNS
  47.       POINTEUR IZ2.POLYNO
  48. *
  49.       INTEGER IMPR,IRET
  50. * Elément de nom : L2D1PR4
  51.       REAL*8 UNS6,UNS2,DEUXS3,UNS3,UN,ZERO
  52.       PARAMETER (UNS6=1.D0/6.D0)
  53.       PARAMETER (UNS2=1.D0/2.D0)
  54.       PARAMETER (DEUXS3=2.D0/3.D0)
  55.       PARAMETER (UNS3=1.D0/3.D0)
  56.       PARAMETER (UN=1.D0)
  57.       PARAMETER (ZERO=0.D0)
  58. *
  59.       INTEGER INDDL
  60. *
  61. * Executable statements
  62. *
  63.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelpr'
  64. *
  65. * Elément de nom : L2D0PR1
  66. * Sur un prisme : élément de Lagrange, fonction L2, approximation
  67. *   nodale, espace de référence de dimension 3, 1 noeuds, 1 degrés de
  68. *   liberté, degré de l'approximation : 0
  69. *
  70. * In INILRF : SEGINI ELCOUR
  71.       CALL INILRF('L2D0PR1','PRISME','LAGRANGE','L2',
  72.      $     3,1,1,0,
  73.      $     ELCOUR,
  74.      $     IMPR,IRET)
  75.       IF (IRET.NE.0) GOTO 9999
  76.       CALL FILRF('L2D0TR1',MYLRFS,ELPRO1,IMPR,IRET)
  77.       IF (IRET.NE.0) GOTO 9999
  78.       CALL FILRF('L2D0SE1',MYLRFS,ELPRO2,IMPR,IRET)
  79.       IF (IRET.NE.0) GOTO 9999
  80.       CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
  81.       IF (IRET.NE.0) GOTO 9999
  82.       ELCOUR.NPQUAF(1)=21
  83.       ELCOUR.NUMCMP(1)=1
  84. * Initialise la correspondance ddl-noeud+ord.der
  85.       CALL INILAG(ELCOUR,IMPR,IRET)
  86.       IF (IRET.NE.0) GOTO 9999
  87.       SEGACT ELPRO1
  88.       MYBPO1=ELPRO1.MBPOLY
  89.       SEGDES ELPRO1
  90.       SEGACT ELPRO2
  91.       MYBPO2=ELPRO2.MBPOLY
  92.       SEGDES ELPRO2
  93. * Calcule la base polynômiale produit
  94.       CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
  95.       IF (IRET.NE.0) GOTO 9999
  96.       ELCOUR.MBPOLY=MYBPOL
  97.       SEGDES ELCOUR
  98.       MYLRFS.LISEL(**)=ELCOUR
  99. *
  100. * Elément de nom : L2D1PR4
  101. * Sur un prisme : élément de Lagrange, fonction L2, approximation
  102. *   nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de
  103. *   liberté, degré de l'approximation : 1
  104. *
  105. * In INILRF : SEGINI ELCOUR
  106.       CALL INILRF('L2D1PR4','PRISME','LAGRANGE','L2',
  107.      $     3,4,4,1,
  108.      $     ELCOUR,
  109.      $     IMPR,IRET)
  110.       IF (IRET.NE.0) GOTO 9999
  111.       ELCOUR.XCONOD(1,1)= UNS6
  112.       ELCOUR.XCONOD(2,1)= UNS6
  113.       ELCOUR.XCONOD(3,1)=-UNS2
  114.       ELCOUR.XCONOD(1,2)= DEUXS3
  115.       ELCOUR.XCONOD(2,2)= UNS6
  116.       ELCOUR.XCONOD(3,2)= UNS2
  117.       ELCOUR.XCONOD(1,3)= UNS6
  118.       ELCOUR.XCONOD(2,3)= DEUXS3
  119.       ELCOUR.XCONOD(3,3)=-UNS2
  120.       ELCOUR.XCONOD(1,4)= UNS3
  121.       ELCOUR.XCONOD(2,4)= UNS3
  122.       ELCOUR.XCONOD(3,4)= UNS2
  123. * Les d.d.l. sont au noeud 21
  124.       DO 199 INDDL=1,4
  125.          ELCOUR.NPQUAF(INDDL)=21
  126.          ELCOUR.NUMCMP(INDDL)=INDDL
  127.  199  CONTINUE
  128. * Initialise la correspondance ddl-noeud+ord.der
  129.       CALL INILAG(ELCOUR,IMPR,IRET)
  130.       IF (IRET.NE.0) GOTO 9999
  131. * Génère une base polynômiale complète (dimension 3, degré 1)
  132.       CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  133.       IF (IRET.NE.0) GOTO 9999
  134.       ELCOUR.MBPOLY=MYBPOL
  135.       SEGDES ELCOUR
  136.       MYLRFS.LISEL(**)=ELCOUR
  137. *
  138. * Elément de nom : H1D1PR6
  139. * Sur un prisme : élément de Lagrange, fonction H1, approximation
  140. *   nodale, espace de référence de dimension 3, 6 noeuds, 6 degrés de
  141. *   liberté, degré de l'approximation : 1
  142. *
  143. * In INILRF : SEGINI ELCOUR
  144.       CALL INILRF('H1D1PR6','PRISME','LAGRANGE','H1',
  145.      $     3,6,6,1,
  146.      $     ELCOUR,
  147.      $     IMPR,IRET)
  148.       IF (IRET.NE.0) GOTO 9999
  149.       CALL FILRF('H1D1TR3',MYLRFS,ELPRO1,IMPR,IRET)
  150.       IF (IRET.NE.0) GOTO 9999
  151.       CALL FILRF('H1D1SE2',MYLRFS,ELPRO2,IMPR,IRET)
  152.       IF (IRET.NE.0) GOTO 9999
  153.       CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
  154.       IF (IRET.NE.0) GOTO 9999
  155. * Les d.d.l. sont aux noeuds 1,3,5...
  156.       DO 201 INDDL=1,3
  157.          ELCOUR.NPQUAF(INDDL)=(2*INDDL)-1
  158.          ELCOUR.NUMCMP(INDDL)=1
  159.  201  CONTINUE
  160. * ... et 10,12,14.
  161.       DO 203 INDDL=4,6
  162.          ELCOUR.NPQUAF(INDDL)=(2*(INDDL-4))+10
  163.          ELCOUR.NUMCMP(INDDL)=1
  164.  203  CONTINUE
  165. * Initialise la correspondance ddl-noeud+ord.der
  166.       CALL INILAG(ELCOUR,IMPR,IRET)
  167.       IF (IRET.NE.0) GOTO 9999
  168.       SEGACT ELPRO1
  169.       MYBPO1=ELPRO1.MBPOLY
  170.       SEGDES ELPRO1
  171.       SEGACT ELPRO2
  172.       MYBPO2=ELPRO2.MBPOLY
  173.       SEGDES ELPRO2
  174. * Calcule la base polynômiale produit
  175.       CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
  176.       IF (IRET.NE.0) GOTO 9999
  177.       ELCOUR.MBPOLY=MYBPOL
  178.       SEGDES ELCOUR
  179.       MYLRFS.LISEL(**)=ELCOUR
  180. *
  181. * Elément de nom : CRD1PR5
  182. * Sur un prisme : élément de Lagrange, fonction continue au centre des
  183. * faces, approximation nodale, espace de référence de dimension 3, 5
  184. *      noeuds, 5 degrés de
  185. *   liberté, degré de l'approximation : 1
  186. *
  187. * In INILRF : SEGINI ELCOUR
  188.       CALL INILRF('CRD1PR5','PRISME','LAGRANGE','HFAC',
  189.      $     3,5,5,1,
  190.      $     ELCOUR,
  191.      $     IMPR,IRET)
  192.       IF (IRET.NE.0) GOTO 9999
  193.       ELCOUR.XCONOD(1,1)=UNS2
  194.       ELCOUR.XCONOD(2,1)=ZERO
  195.       ELCOUR.XCONOD(3,1)=ZERO
  196.       ELCOUR.XCONOD(1,2)=UNS2
  197.       ELCOUR.XCONOD(2,2)=UNS2
  198.       ELCOUR.XCONOD(3,2)=ZERO
  199.       ELCOUR.XCONOD(1,3)=ZERO
  200.       ELCOUR.XCONOD(2,3)=UNS2
  201.       ELCOUR.XCONOD(3,3)=ZERO
  202.       ELCOUR.XCONOD(1,4)=UNS3
  203.       ELCOUR.XCONOD(2,4)=UNS3
  204.       ELCOUR.XCONOD(3,4)=-UN
  205.       ELCOUR.XCONOD(1,5)=UNS3
  206.       ELCOUR.XCONOD(2,5)=UNS3
  207.       ELCOUR.XCONOD(3,5)=+UN
  208. * Les d.d.l. sont aux noeuds 16,17,18,19,20
  209.       DO INDDL=1,5
  210.          ELCOUR.NPQUAF(INDDL)=INDDL+15
  211.          ELCOUR.NUMCMP(INDDL)=1
  212.       ENDDO
  213. * Initialise la correspondance ddl-noeud+ord.der
  214.       CALL INILAG(ELCOUR,IMPR,IRET)
  215.       IF (IRET.NE.0) GOTO 9999
  216. * Génère une base polynômiale complète (dimension 3, degré 1)
  217.       CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
  218.       IF (IRET.NE.0) GOTO 9999
  219. * Il faut rajouter le monôme z^2
  220.       SEGACT MYBPOL*MOD
  221.       NDIML=3
  222.       NBMON=1
  223.       SEGINI IZ2
  224.       IZ2.COEMON(1)=UN
  225.       IZ2.EXPMON(3,1)=2
  226.       SEGDES IZ2
  227.       MYBPOL.LIPOLY(**)=IZ2
  228.       SEGDES MYBPOL
  229.       ELCOUR.MBPOLY=MYBPOL
  230.       SEGDES ELCOUR
  231.       MYLRFS.LISEL(**)=ELCOUR
  232. *
  233. * Elément de nom : H1D2PR15
  234. * Sur un prisme : élément de Lagrange incomplet (Serendip),
  235. *   fonction H1, approximation
  236. *   nodale, espace de référence de dimension 3, 15 noeuds, 15 degrés de
  237. *   liberté, degré de l'approximation : 2
  238. *
  239. * In INILRF : SEGINI ELCOUR
  240.       CALL INILRF('H1D2PR15','PRISME','LAGRANGE','H1',
  241.      $     3,15,15,2,
  242.      $     ELCOUR,
  243.      $     IMPR,IRET)
  244.       IF (IRET.NE.0) GOTO 9999
  245.       CALL FILRF('H1D2TR6',MYLRFS,ELPRO1,IMPR,IRET)
  246.       IF (IRET.NE.0) GOTO 9999
  247.       CALL FILRF('H1D1TR3',MYLRFS,ELPRO2,IMPR,IRET)
  248.       IF (IRET.NE.0) GOTO 9999
  249. C Inutile
  250. C      ELCOUR.XCONOD(1,1)=ZERO
  251. C      ELCOUR.XCONOD(2,1)=ZERO
  252. C      ELCOUR.XCONOD(3,1)=ZERO
  253. * Les d.d.l. sont aux noeuds 1,...,15
  254.       DO 217 INDDL=1,15
  255.          ELCOUR.NPQUAF(INDDL)=INDDL
  256.          ELCOUR.NUMCMP(INDDL)=1
  257.  217  CONTINUE
  258. * Initialise la correspondance ddl-noeud+ord.der
  259.       CALL INILAG(ELCOUR,IMPR,IRET)
  260.       IF (IRET.NE.0) GOTO 9999
  261. * Pas de base polynômiale (on recopie l'élément de castem)
  262.       ELCOUR.MBPOLY=0
  263.       SEGDES ELCOUR
  264.       MYLRFS.LISEL(**)=ELCOUR
  265. *
  266. * Elément de nom : H1D2PR18
  267. * Sur un prisme : élément de Lagrange, fonction H1, approximation
  268. *   nodale, espace de référence de dimension 3, 18 noeuds, 18 degrés de
  269. *   liberté, degré de l'approximation : 2
  270. *
  271. * In INILRF : SEGINI ELCOUR
  272.       CALL INILRF('H1D2PR18','PRISME','LAGRANGE','H1',
  273.      $     3,18,18,2,
  274.      $     ELCOUR,
  275.      $     IMPR,IRET)
  276.       IF (IRET.NE.0) GOTO 9999
  277.       CALL FILRF('H1D2TR6',MYLRFS,ELPRO1,IMPR,IRET)
  278.       IF (IRET.NE.0) GOTO 9999
  279.       CALL FILRF('H1D2SE3',MYLRFS,ELPRO2,IMPR,IRET)
  280.       IF (IRET.NE.0) GOTO 9999
  281.       CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
  282.       IF (IRET.NE.0) GOTO 9999
  283. * Les ieme d.d.l sont aux noeuds j
  284.       DO IDDL=1,6
  285.          ELCOUR.NPQUAF(IDDL)=IDDL
  286.       ENDDO
  287.       ELCOUR.NPQUAF( 7)= 7
  288.       ELCOUR.NPQUAF( 8)=16
  289.       ELCOUR.NPQUAF( 9)= 8
  290.       ELCOUR.NPQUAF(10)=17
  291.       ELCOUR.NPQUAF(11)= 9
  292.       ELCOUR.NPQUAF(12)=18
  293.       DO IDDL=13,18
  294.          ELCOUR.NPQUAF(IDDL)=IDDL-3
  295.       ENDDO
  296.       DO IDDL=1,18
  297.          ELCOUR.NUMCMP(IDDL)=1
  298.       ENDDO
  299. * Initialise la correspondance ddl-noeud+ord.der
  300.       CALL INILAG(ELCOUR,IMPR,IRET)
  301.       IF (IRET.NE.0) GOTO 9999
  302.       SEGACT ELPRO1
  303.       MYBPO1=ELPRO1.MBPOLY
  304.       SEGDES ELPRO1
  305.       SEGACT ELPRO2
  306.       MYBPO2=ELPRO2.MBPOLY
  307.       SEGDES ELPRO2
  308. * Calcule la base polynômiale produit
  309.       CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
  310.       IF (IRET.NE.0) GOTO 9999
  311.       ELCOUR.MBPOLY=MYBPOL
  312.       SEGDES ELCOUR
  313.       MYLRFS.LISEL(**)=ELCOUR
  314. *
  315. * Elément de nom : H1D2PR21
  316. * Sur un prisme : élément de Lagrange, fonction H1, approximation
  317. *   nodale, espace de référence de dimension 3, 21 noeuds, 21 degrés de
  318. *   liberté, degré de l'approximation : 2
  319. *
  320. * In INILRF : SEGINI ELCOUR
  321.       CALL INILRF('H1D2PR21','PRISME','LAGRANGE','H1',
  322.      $     3,21,21,2,
  323.      $     ELCOUR,
  324.      $     IMPR,IRET)
  325.       IF (IRET.NE.0) GOTO 9999
  326.       CALL FILRF('H1D2TR7',MYLRFS,ELPRO1,IMPR,IRET)
  327.       IF (IRET.NE.0) GOTO 9999
  328.       CALL FILRF('H1D2SE3',MYLRFS,ELPRO2,IMPR,IRET)
  329.       IF (IRET.NE.0) GOTO 9999
  330.       CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
  331.       IF (IRET.NE.0) GOTO 9999
  332. * Les ieme d.d.l sont aux noeuds j
  333.       DO IDDL=1,6
  334.          ELCOUR.NPQUAF(IDDL)=IDDL
  335.       ENDDO
  336.       ELCOUR.NPQUAF( 7)=19
  337.       ELCOUR.NPQUAF( 8)= 7
  338.       ELCOUR.NPQUAF( 9)=16
  339.       ELCOUR.NPQUAF(10)= 8
  340.       ELCOUR.NPQUAF(11)=17
  341.       ELCOUR.NPQUAF(12)= 9
  342.       ELCOUR.NPQUAF(13)=18
  343.       ELCOUR.NPQUAF(14)=21
  344.       DO IDDL=15,20
  345.          ELCOUR.NPQUAF(IDDL)=IDDL-5
  346.       ENDDO
  347.       ELCOUR.NPQUAF(21)=20
  348.       DO IDDL=1,21
  349.          ELCOUR.NUMCMP(IDDL)=1
  350.       ENDDO
  351. * Initialise la correspondance ddl-noeud+ord.der
  352.       CALL INILAG(ELCOUR,IMPR,IRET)
  353.       IF (IRET.NE.0) GOTO 9999
  354.       SEGACT ELPRO1
  355.       MYBPO1=ELPRO1.MBPOLY
  356.       SEGDES ELPRO1
  357.       SEGACT ELPRO2
  358.       MYBPO2=ELPRO2.MBPOLY
  359.       SEGDES ELPRO2
  360. * Calcule la base polynômiale produit
  361.       CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
  362.       IF (IRET.NE.0) GOTO 9999
  363.       ELCOUR.MBPOLY=MYBPOL
  364.       SEGDES ELCOUR
  365.       MYLRFS.LISEL(**)=ELCOUR
  366. *
  367. * Normal termination
  368. *
  369.       IRET=0
  370.       RETURN
  371. *
  372. * Format handling
  373. *
  374. *
  375. * Error handling
  376. *
  377.  9999 CONTINUE
  378.       IRET=1
  379.       WRITE(IOIMP,*) 'An error was detected in subroutine inelpr'
  380.       RETURN
  381. *
  382. * End of subroutine INELPR
  383. *
  384.       END
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  

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