Télécharger inqrpy.eso

Retour à la liste

Numérotation des lignes :

  1. C INQRPY SOURCE BP208322 16/11/18 21:17:45 9177
  2. SUBROUTINE INQRPY(MYQRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INQRPY
  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, 01/08/06, version initiale
  22. C HISTORIQUE : v1, 01/08/06, 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 (UNS5=1.D0/5.D0)
  56. *
  57. INTEGER NUMER
  58. *
  59. * Executable statements
  60. *
  61. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrpy'
  62. *
  63. * Elément QUAF PY19
  64. *
  65.  
  66. NDIMQR=3
  67. NBNOQR=19
  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('PY19',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)=UN
  81. QRCOUR.XCONQR(2,1)=ZERO
  82. QRCOUR.XCONQR(3,1)=ZERO
  83. QRCOUR.XCONQR(1,2)=UNS2
  84. QRCOUR.XCONQR(2,2)=UNS2
  85. QRCOUR.XCONQR(3,2)=ZERO
  86. QRCOUR.XCONQR(1,3)=ZERO
  87. QRCOUR.XCONQR(2,3)=UN
  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)=-UN
  93. QRCOUR.XCONQR(2,5)=ZERO
  94. QRCOUR.XCONQR(3,5)=ZERO
  95. QRCOUR.XCONQR(1,6)=-UNS2
  96. QRCOUR.XCONQR(2,6)=-UNS2
  97. QRCOUR.XCONQR(3,6)=ZERO
  98. QRCOUR.XCONQR(1,7)=ZERO
  99. QRCOUR.XCONQR(2,7)=-UN
  100. QRCOUR.XCONQR(3,7)=ZERO
  101. QRCOUR.XCONQR(1,8)=UNS2
  102. QRCOUR.XCONQR(2,8)=-UNS2
  103. QRCOUR.XCONQR(3,8)=ZERO
  104. *
  105. QRCOUR.XCONQR(1,9)=UNS2
  106. QRCOUR.XCONQR(2,9)=ZERO
  107. QRCOUR.XCONQR(3,9)=UNS2
  108. QRCOUR.XCONQR(1,10)=ZERO
  109. QRCOUR.XCONQR(2,10)=UNS2
  110. QRCOUR.XCONQR(3,10)=UNS2
  111. QRCOUR.XCONQR(1,11)=-UNS2
  112. QRCOUR.XCONQR(2,11)=ZERO
  113. QRCOUR.XCONQR(3,11)=UNS2
  114. QRCOUR.XCONQR(1,12)=ZERO
  115. QRCOUR.XCONQR(2,12)=-UNS2
  116. QRCOUR.XCONQR(3,12)=ZERO
  117. *
  118. QRCOUR.XCONQR(1,13)=ZERO
  119. QRCOUR.XCONQR(2,13)=ZERO
  120. QRCOUR.XCONQR(3,13)=UN
  121. QRCOUR.XCONQR(1,14)=ZERO
  122. QRCOUR.XCONQR(2,14)=ZERO
  123. QRCOUR.XCONQR(3,14)=ZERO
  124. *
  125. QRCOUR.XCONQR(1,15)=UNS3
  126. QRCOUR.XCONQR(2,15)=UNS3
  127. QRCOUR.XCONQR(3,15)=UNS3
  128. QRCOUR.XCONQR(1,16)=-UNS3
  129. QRCOUR.XCONQR(2,16)=UNS3
  130. QRCOUR.XCONQR(3,16)=UNS3
  131. QRCOUR.XCONQR(1,17)=-UNS3
  132. QRCOUR.XCONQR(2,17)=-UNS3
  133. QRCOUR.XCONQR(3,17)=UNS3
  134. QRCOUR.XCONQR(1,18)=UNS3
  135. QRCOUR.XCONQR(2,18)=-UNS3
  136. QRCOUR.XCONQR(3,18)=UNS3
  137. *
  138. QRCOUR.XCONQR(1,19)=ZERO
  139. QRCOUR.XCONQR(2,19)=ZERO
  140. QRCOUR.XCONQR(3,19)=UNS5
  141.  
  142. *
  143. * Numero du centre
  144. *
  145. QRCOUR.NUCENT=19
  146. *
  147. * Faces du PY19 : 1 QUA9 + 4 TRI7
  148. *
  149. * Chapeau
  150. NBNN=0
  151. NBELEM=0
  152. NBSOUS=2
  153. NBREF=0
  154. SEGINI MYMEL
  155. * Face QUA9
  156. NBNN=9
  157. NBELEM=1
  158. NBSOUS=0
  159. NBREF=0
  160. SEGINI SOUMEL
  161. CALL FICH4('QUA9',NOMS,NOMBR,
  162. $ NUMER,
  163. $ IMPR,IRET)
  164. IF (IRET.NE.0) GOTO 9999
  165. SOUMEL.ITYPEL=NUMER
  166. * Face 1
  167. SOUMEL.NUM(1,1)=1
  168. SOUMEL.NUM(2,1)=2
  169. SOUMEL.NUM(3,1)=3
  170. SOUMEL.NUM(4,1)=4
  171. SOUMEL.NUM(5,1)=5
  172. SOUMEL.NUM(6,1)=6
  173. SOUMEL.NUM(7,1)=7
  174. SOUMEL.NUM(8,1)=8
  175. SOUMEL.NUM(9,1)=14
  176. *
  177. SEGDES SOUMEL
  178. MYMEL.LISOUS(1)=SOUMEL
  179. * 4 Faces TRI7
  180. NBNN=7
  181. NBELEM=4
  182. NBSOUS=0
  183. NBREF=0
  184. SEGINI SOUMEL
  185. CALL FICH4('TRI7',NOMS,NOMBR,
  186. $ NUMER,
  187. $ IMPR,IRET)
  188. IF (IRET.NE.0) GOTO 9999
  189. SOUMEL.ITYPEL=NUMER
  190. * Face 1
  191. SOUMEL.NUM(1,1)=1
  192. SOUMEL.NUM(2,1)=2
  193. SOUMEL.NUM(3,1)=3
  194. SOUMEL.NUM(4,1)=10
  195. SOUMEL.NUM(5,1)=13
  196. SOUMEL.NUM(6,1)=9
  197. SOUMEL.NUM(7,1)=15
  198. * Face 2
  199. SOUMEL.NUM(1,2)=3
  200. SOUMEL.NUM(2,2)=4
  201. SOUMEL.NUM(3,2)=5
  202. SOUMEL.NUM(4,2)=11
  203. SOUMEL.NUM(5,2)=13
  204. SOUMEL.NUM(6,2)=10
  205. SOUMEL.NUM(7,2)=16
  206. * Face 3
  207. SOUMEL.NUM(1,3)=5
  208. SOUMEL.NUM(2,3)=6
  209. SOUMEL.NUM(3,3)=7
  210. SOUMEL.NUM(4,3)=12
  211. SOUMEL.NUM(5,3)=13
  212. SOUMEL.NUM(6,3)=11
  213. SOUMEL.NUM(7,3)=17
  214. * Face 4
  215. SOUMEL.NUM(1,4)=7
  216. SOUMEL.NUM(2,4)=8
  217. SOUMEL.NUM(3,4)=1
  218. SOUMEL.NUM(4,4)=9
  219. SOUMEL.NUM(5,4)=13
  220. SOUMEL.NUM(6,4)=12
  221. SOUMEL.NUM(7,4)=18
  222. *
  223. SEGDES SOUMEL
  224. MYMEL.LISOUS(2)=SOUMEL
  225. SEGDES MYMEL
  226. QRCOUR.LFACE=MYMEL
  227. SEGDES QRCOUR
  228. MYQRFS.LISQRF(**)=QRCOUR
  229. *
  230. * Normal termination
  231. *
  232. IRET=0
  233. RETURN
  234. *
  235. * Format handling
  236. *
  237. *
  238. * Error handling
  239. *
  240. 9999 CONTINUE
  241. IRET=1
  242. WRITE(IOIMP,*) 'An error was detected in subroutine inqrpy'
  243. RETURN
  244. *
  245. * End of subroutine INQRPY
  246. *
  247. END
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  

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