Télécharger inelpy.eso

Retour à la liste

Numérotation des lignes :

  1. C INELPY SOURCE GOUNAND 05/12/21 21:31:07 5281
  2. SUBROUTINE INELPY(MYLRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INELPY
  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 pyramidale.
  11. C C'est la pyramide de Castem
  12. C
  13.  
  14.  
  15. C REFERENCES :
  16. C LANGAGE : ESOPE
  17. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  18. C mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES : INILRF, INILAG, GBAPCO, GPOBUL, GPOFBU
  21. C APPELE PAR : INLRFS
  22. C***********************************************************************
  23. C ENTREES : -
  24. C ENTREES/SORTIES : MYLRFS
  25. C SORTIES : -
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION : v1, 23/03/00, version initiale
  29. C HISTORIQUE : v1, 23/03/00, création
  30. C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF
  31. C HISTORIQUE :
  32. C HISTORIQUE :
  33. C***********************************************************************
  34. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35. C en cas de modification de ce sous-programme afin de faciliter
  36. C la maintenance !
  37. C***********************************************************************
  38. -INC CCOPTIO
  39. CBEGININCLUDE SELREF
  40. SEGMENT ELREF
  41. CHARACTER*(LNNOM) NOMLRF
  42. CHARACTER*(LNFORM) FORME
  43. CHARACTER*(LNTYPL) TYPEL
  44. CHARACTER*(LNESP) ESPACE
  45. INTEGER DEGRE
  46. REAL*8 XCONOD(NDIMEL,NBNOD)
  47. INTEGER NPQUAF(NBDDL)
  48. INTEGER NUMCMP(NBDDL)
  49. INTEGER QUENOD(NBDDL)
  50. INTEGER ORDDER(NDIMEL,NBDDL)
  51. POINTEUR MBPOLY.POLYNS
  52. ENDSEGMENT
  53. SEGMENT ELREFS
  54. POINTEUR LISEL(0).ELREF
  55. ENDSEGMENT
  56. CENDINCLUDE SELREF
  57. POINTEUR MYLRFS.ELREFS
  58. POINTEUR ELCOUR.ELREF
  59. CBEGININCLUDE SPOLYNO
  60. SEGMENT POLYNO
  61. REAL*8 COEMON(NBMON)
  62. INTEGER EXPMON(NDIML,NBMON)
  63. ENDSEGMENT
  64. SEGMENT POLYNS
  65. POINTEUR LIPOLY(NBPOLY).POLYNO
  66. ENDSEGMENT
  67. CENDINCLUDE SPOLYNO
  68. POINTEUR MYBPOL.POLYNS
  69. *
  70. INTEGER IMPR,IRET
  71. * Elément de nom : L2D0PY1
  72. REAL*8 UNS4
  73. PARAMETER (UNS4=0.25D0)
  74. * Elément de nom : H1D1PY5
  75. REAL*8 ZERO,UN
  76. PARAMETER (ZERO=0.D0,UN=1.D0)
  77. * Elément de nom : H1D2PY13
  78. REAL*8 UNS2,UNS3
  79. PARAMETER (UNS2=1.D0/2.D0,UNS3=1.D0/3.D0)
  80. *
  81. INTEGER INDDL
  82. *
  83. * Executable statements
  84. *
  85. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelpy'
  86. *
  87. * Elément de nom : L2D0PY1
  88. * Sur une pyramide : élément de Lagrange, fonction L2, approximation
  89. * nodale, espace de référence de dimension 3, 1 noeud, 1 degré de
  90. * liberté, degré de l'approximation : 0
  91. *
  92. * In INILRF : SEGINI ELCOUR
  93. CALL INILRF('L2D0PY1','PYRAMIDE','LAGRANGE','L2',
  94. $ 3,1,1,0,
  95. $ ELCOUR,
  96. $ IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. C Inutile
  99. C ELCOUR.XCONOD(1,1)=UNS4
  100. C ELCOUR.XCONOD(2,1)=ZERO
  101. C ELCOUR.XCONOD(3,1)=ZERO
  102. ELCOUR.NPQUAF(1)=19
  103. ELCOUR.NUMCMP(1)=1
  104. * Initialise la correspondance ddl-noeud+ord.der
  105. CALL INILAG(ELCOUR,IMPR,IRET)
  106. IF (IRET.NE.0) GOTO 9999
  107. * Pas de base polynomiale
  108. ELCOUR.MBPOLY=0
  109. SEGDES ELCOUR
  110. MYLRFS.LISEL(**)=ELCOUR
  111. *
  112. * Elément de nom : H1D1PY5
  113. * Sur une pyramide : élément de Lagrange, fonction H1, approximation
  114. * nodale, espace de référence de dimension 3, 5 noeuds, 5 degrés de
  115. * liberté, degré de l'approximation : 1 (environ)
  116. *
  117. * In INILRF : SEGINI ELCOUR
  118. CALL INILRF('H1D1PY5','PYRAMIDE','LAGRANGE','H1',
  119. $ 3,5,5,1,
  120. $ ELCOUR,
  121. $ IMPR,IRET)
  122. IF (IRET.NE.0) GOTO 9999
  123. C Inutile
  124. C ELCOUR.XCONOD(1,1)=ZERO
  125. C ELCOUR.XCONOD(2,1)=ZERO
  126. C ELCOUR.XCONOD(3,1)=ZERO
  127. * Les d.d.l. sont aux noeuds 1,3,5,7,13
  128. ELCOUR.NPQUAF(1)=1
  129. ELCOUR.NPQUAF(2)=3
  130. ELCOUR.NPQUAF(3)=5
  131. ELCOUR.NPQUAF(4)=7
  132. ELCOUR.NPQUAF(5)=13
  133. DO 213 INDDL=1,5
  134. ELCOUR.NUMCMP(INDDL)=1
  135. 213 CONTINUE
  136. * Initialise la correspondance ddl-noeud+ord.der
  137. CALL INILAG(ELCOUR,IMPR,IRET)
  138. IF (IRET.NE.0) GOTO 9999
  139. *Pas de base polynômiale
  140. ELCOUR.MBPOLY=0
  141. SEGDES ELCOUR
  142. MYLRFS.LISEL(**)=ELCOUR
  143. *
  144. * Elément de nom : H1D2PY13
  145. * Sur une pyramide : élément de Lagrange, fonction H1, approximation
  146. * nodale, espace de référence de dimension 3, 13 noeuds, 13 degrés de
  147. * liberté, degré de l'approximation : 2 (environ)
  148. *
  149. * In INILRF : SEGINI ELCOUR
  150. CALL INILRF('H1D2PY13','PYRAMIDE','LAGRANGE','H1',
  151. $ 3,13,13,2,
  152. $ ELCOUR,
  153. $ IMPR,IRET)
  154. IF (IRET.NE.0) GOTO 9999
  155. C Inutile
  156. C ELCOUR.XCONOD(1,1)=ZERO
  157. C ELCOUR.XCONOD(2,1)=ZERO
  158. C ELCOUR.XCONOD(3,1)=ZERO
  159. * Les d.d.l. sont aux noeuds 1,...,13
  160. DO 217 INDDL=1,13
  161. ELCOUR.NPQUAF(INDDL)=INDDL
  162. ELCOUR.NUMCMP(INDDL)=1
  163. 217 CONTINUE
  164. * Initialise la correspondance ddl-noeud+ord.der
  165. CALL INILAG(ELCOUR,IMPR,IRET)
  166. IF (IRET.NE.0) GOTO 9999
  167. * Pas de base polynômiale (on recopie l'élément de castem)
  168. ELCOUR.MBPOLY=0
  169. SEGDES ELCOUR
  170. MYLRFS.LISEL(**)=ELCOUR
  171. *
  172. * Normal termination
  173. *
  174. IRET=0
  175. RETURN
  176. *
  177. * Format handling
  178. *
  179. *
  180. * Error handling
  181. *
  182. 9999 CONTINUE
  183. IRET=1
  184. WRITE(IOIMP,*) 'An error was detected in subroutine inelpy'
  185. RETURN
  186. *
  187. * End of subroutine INELPY
  188. *
  189. END
  190.  
  191.  
  192.  
  193.  

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