Télécharger inqrte.eso

Retour à la liste

Numérotation des lignes :

  1. C INQRTE SOURCE BP208322 16/11/18 21:17:47 9177
  2. SUBROUTINE INQRTE(MYQRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INQRTE
  7. C PROJET : Noyau linéaire NLIN
  8. C DESCRIPTION :
  9. C LANGAGE : ESOPE
  10. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  11. C mél : gounand@semt2.smts.cea.fr
  12. C***********************************************************************
  13. C APPELES :
  14. C APPELE PAR :
  15. C***********************************************************************
  16. C ENTREES : -
  17. C ENTREES/SORTIES :
  18. C SORTIES : -
  19. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  20. C***********************************************************************
  21. C VERSION : v1, 17/10/02, version initiale
  22. C HISTORIQUE : v1, 17/10/02, création
  23. C HISTORIQUE :
  24. C HISTORIQUE :
  25. C***********************************************************************
  26. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  27. C en cas de modification de ce sous-programme afin de faciliter
  28. C la maintenance !
  29. C***********************************************************************
  30. -INC CCOPTIO
  31. -INC CCGEOME
  32. CBEGININCLUDE SIQUAF
  33. SEGMENT IQUAF
  34. INTEGER NUMQUF
  35. REAL*8 XCONQR(NDIMQR,NBNOQR)
  36. INTEGER NUCENT
  37. POINTEUR LFACE.MELEME
  38. ENDSEGMENT
  39. SEGMENT IQUAFS
  40. POINTEUR LISQRF(NBQRF).IQUAF
  41. ENDSEGMENT
  42. CENDINCLUDE SIQUAF
  43. POINTEUR MYQRFS.IQUAFS
  44. POINTEUR QRCOUR.IQUAF
  45. INTEGER NDIMQR,NBNOQR
  46. -INC SMELEME
  47. POINTEUR MYMEL.MELEME
  48. POINTEUR SOUMEL.MELEME
  49. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  50. *
  51. INTEGER IMPR,IRET
  52. REAL*8 ZERO,UN,UNS3,UNS2,UNS4
  53. *
  54. PARAMETER (ZERO=0.D0,UN=1.D0,UNS3=1.D0/3.D0,UNS2=1.D0/2.D0)
  55. PARAMETER (UNS4=1.D0/4.D0)
  56. *
  57. INTEGER NUMER
  58. *
  59. * Executable statements
  60. *
  61. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrte'
  62. *
  63. * Elément QUAF TE15
  64. *
  65.  
  66. NDIMQR=3
  67. NBNOQR=15
  68. SEGINI QRCOUR
  69. * Numéro de l'élément géométrique dans NOMS
  70. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  71. * cf. include CCGEOME
  72. CALL FICH4('TE15',NOMS,NOMBR,
  73. $ NUMER,
  74. $ IMPR,IRET)
  75. IF (IRET.NE.0) GOTO 9999
  76. QRCOUR.NUMQUF=NUMER
  77. *
  78. * Coordonnées des noeuds du QUAF de référence
  79. *
  80. QRCOUR.XCONQR(1,1)=ZERO
  81. QRCOUR.XCONQR(2,1)=ZERO
  82. QRCOUR.XCONQR(3,1)=ZERO
  83. QRCOUR.XCONQR(1,2)=UNS2
  84. QRCOUR.XCONQR(2,2)=ZERO
  85. QRCOUR.XCONQR(3,2)=ZERO
  86. QRCOUR.XCONQR(1,3)=UN
  87. QRCOUR.XCONQR(2,3)=ZERO
  88. QRCOUR.XCONQR(3,3)=ZERO
  89. QRCOUR.XCONQR(1,4)=UNS2
  90. QRCOUR.XCONQR(2,4)=UNS2
  91. QRCOUR.XCONQR(3,4)=ZERO
  92. QRCOUR.XCONQR(1,5)=ZERO
  93. QRCOUR.XCONQR(2,5)=UN
  94. QRCOUR.XCONQR(3,5)=ZERO
  95. QRCOUR.XCONQR(1,6)=ZERO
  96. QRCOUR.XCONQR(2,6)=UNS2
  97. QRCOUR.XCONQR(3,6)=ZERO
  98. *
  99. QRCOUR.XCONQR(1,7)=ZERO
  100. QRCOUR.XCONQR(2,7)=ZERO
  101. QRCOUR.XCONQR(3,7)=UNS2
  102. QRCOUR.XCONQR(1,8)=UNS2
  103. QRCOUR.XCONQR(2,8)=ZERO
  104. QRCOUR.XCONQR(3,8)=UNS2
  105. QRCOUR.XCONQR(1,9)=ZERO
  106. QRCOUR.XCONQR(2,9)=UNS2
  107. QRCOUR.XCONQR(3,9)=UNS2
  108. QRCOUR.XCONQR(1,10)=ZERO
  109. QRCOUR.XCONQR(2,10)=ZERO
  110. QRCOUR.XCONQR(3,10)=UN
  111. *
  112. QRCOUR.XCONQR(1,11)=UNS3
  113. QRCOUR.XCONQR(2,11)=UNS3
  114. QRCOUR.XCONQR(3,11)=ZERO
  115. QRCOUR.XCONQR(1,12)=UNS3
  116. QRCOUR.XCONQR(2,12)=ZERO
  117. QRCOUR.XCONQR(3,12)=UNS3
  118. QRCOUR.XCONQR(1,13)=UNS3
  119. QRCOUR.XCONQR(2,13)=UNS3
  120. QRCOUR.XCONQR(3,13)=UNS3
  121. QRCOUR.XCONQR(1,14)=ZERO
  122. QRCOUR.XCONQR(2,14)=UNS3
  123. QRCOUR.XCONQR(3,14)=UNS3
  124. QRCOUR.XCONQR(1,15)=UNS4
  125. QRCOUR.XCONQR(2,15)=UNS4
  126. QRCOUR.XCONQR(3,15)=UNS4
  127. *
  128. * Numero du centre
  129. *
  130. QRCOUR.NUCENT=15
  131. *
  132. * Faces du TE15 : 4 TRI7
  133. *
  134. * Chapeau
  135. NBNN=0
  136. NBELEM=0
  137. NBSOUS=1
  138. NBREF=0
  139. SEGINI MYMEL
  140. * Faces TRI7
  141. NBNN=7
  142. NBELEM=4
  143. NBSOUS=0
  144. NBREF=0
  145. SEGINI SOUMEL
  146. CALL FICH4('TRI7',NOMS,NOMBR,
  147. $ NUMER,
  148. $ IMPR,IRET)
  149. IF (IRET.NE.0) GOTO 9999
  150. SOUMEL.ITYPEL=NUMER
  151. * Face 1
  152. SOUMEL.NUM(1,1)=1
  153. SOUMEL.NUM(2,1)=2
  154. SOUMEL.NUM(3,1)=3
  155. SOUMEL.NUM(4,1)=4
  156. SOUMEL.NUM(5,1)=5
  157. SOUMEL.NUM(6,1)=6
  158. SOUMEL.NUM(7,1)=11
  159. * Face 2
  160. SOUMEL.NUM(1,2)=1
  161. SOUMEL.NUM(2,2)=2
  162. SOUMEL.NUM(3,2)=3
  163. SOUMEL.NUM(4,2)=8
  164. SOUMEL.NUM(5,2)=10
  165. SOUMEL.NUM(6,2)=7
  166. SOUMEL.NUM(7,2)=12
  167. * Face 3
  168. SOUMEL.NUM(1,3)=3
  169. SOUMEL.NUM(2,3)=4
  170. SOUMEL.NUM(3,3)=5
  171. SOUMEL.NUM(4,3)=9
  172. SOUMEL.NUM(5,3)=10
  173. SOUMEL.NUM(6,3)=8
  174. SOUMEL.NUM(7,3)=13
  175. * Face 4
  176. SOUMEL.NUM(1,4)=1
  177. SOUMEL.NUM(2,4)=6
  178. SOUMEL.NUM(3,4)=5
  179. SOUMEL.NUM(4,4)=9
  180. SOUMEL.NUM(5,4)=10
  181. SOUMEL.NUM(6,4)=7
  182. SOUMEL.NUM(7,4)=14
  183. *
  184. SEGDES SOUMEL
  185. MYMEL.LISOUS(1)=SOUMEL
  186. SEGDES MYMEL
  187. QRCOUR.LFACE=MYMEL
  188. SEGDES QRCOUR
  189. MYQRFS.LISQRF(**)=QRCOUR
  190. *
  191. * Normal termination
  192. *
  193. IRET=0
  194. RETURN
  195. *
  196. * Format handling
  197. *
  198. *
  199. * Error handling
  200. *
  201. 9999 CONTINUE
  202. IRET=1
  203. WRITE(IOIMP,*) 'An error was detected in subroutine inqrte'
  204. RETURN
  205. *
  206. * End of subroutine INQRTE
  207. *
  208. END
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  

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