Télécharger inelse.eso

Retour à la liste

Numérotation des lignes :

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

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