Télécharger inqrpy.eso

Retour à la liste

Numérotation des lignes :

inqrpy
  1. C INQRPY SOURCE GOUNAND 21/06/02 21:16:58 11022
  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.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCGEOME
  34. -INC TNLIN
  35. *-INC SIQUAF
  36. POINTEUR MYQRFS.IQUAFS
  37. POINTEUR QRCOUR.IQUAF
  38. INTEGER NDIMQR,NBNOQR
  39. -INC SMELEME
  40. POINTEUR MYMEL.MELEME
  41. POINTEUR SOUMEL.MELEME
  42. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  43. *
  44. INTEGER IMPR,IRET
  45. REAL*8 ZERO,UN,UNS3,UNS2,UNS4
  46. *
  47. PARAMETER (ZERO=0.D0,UN=1.D0,UNS3=1.D0/3.D0,UNS2=1.D0/2.D0)
  48. PARAMETER (UNS5=1.D0/5.D0)
  49. *
  50. INTEGER NUMER
  51. *
  52. * Executable statements
  53. *
  54. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrpy'
  55. *
  56. * Elément QUAF PY19
  57. *
  58.  
  59. NDIMQR=3
  60. NBNOQR=19
  61. SEGINI QRCOUR
  62. * Numéro de l'élément géométrique dans NOMS
  63. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  64. * cf. include CCGEOME
  65. CALL FICH4('PY19',NOMS,NOMBR,
  66. $ NUMER,
  67. $ IMPR,IRET)
  68. IF (IRET.NE.0) GOTO 9999
  69. QRCOUR.NUMQUF=NUMER
  70. *
  71. * Coordonnées des noeuds du QUAF de référence
  72. *
  73. QRCOUR.XCONQR(1,1)=UN
  74. QRCOUR.XCONQR(2,1)=ZERO
  75. QRCOUR.XCONQR(3,1)=ZERO
  76. QRCOUR.XCONQR(1,2)=UNS2
  77. QRCOUR.XCONQR(2,2)=UNS2
  78. QRCOUR.XCONQR(3,2)=ZERO
  79. QRCOUR.XCONQR(1,3)=ZERO
  80. QRCOUR.XCONQR(2,3)=UN
  81. QRCOUR.XCONQR(3,3)=ZERO
  82. QRCOUR.XCONQR(1,4)=-UNS2
  83. QRCOUR.XCONQR(2,4)=UNS2
  84. QRCOUR.XCONQR(3,4)=ZERO
  85. QRCOUR.XCONQR(1,5)=-UN
  86. QRCOUR.XCONQR(2,5)=ZERO
  87. QRCOUR.XCONQR(3,5)=ZERO
  88. QRCOUR.XCONQR(1,6)=-UNS2
  89. QRCOUR.XCONQR(2,6)=-UNS2
  90. QRCOUR.XCONQR(3,6)=ZERO
  91. QRCOUR.XCONQR(1,7)=ZERO
  92. QRCOUR.XCONQR(2,7)=-UN
  93. QRCOUR.XCONQR(3,7)=ZERO
  94. QRCOUR.XCONQR(1,8)=UNS2
  95. QRCOUR.XCONQR(2,8)=-UNS2
  96. QRCOUR.XCONQR(3,8)=ZERO
  97. *
  98. QRCOUR.XCONQR(1,9)=UNS2
  99. QRCOUR.XCONQR(2,9)=ZERO
  100. QRCOUR.XCONQR(3,9)=UNS2
  101. QRCOUR.XCONQR(1,10)=ZERO
  102. QRCOUR.XCONQR(2,10)=UNS2
  103. QRCOUR.XCONQR(3,10)=UNS2
  104. QRCOUR.XCONQR(1,11)=-UNS2
  105. QRCOUR.XCONQR(2,11)=ZERO
  106. QRCOUR.XCONQR(3,11)=UNS2
  107. QRCOUR.XCONQR(1,12)=ZERO
  108. QRCOUR.XCONQR(2,12)=-UNS2
  109. QRCOUR.XCONQR(3,12)=ZERO
  110. *
  111. QRCOUR.XCONQR(1,13)=ZERO
  112. QRCOUR.XCONQR(2,13)=ZERO
  113. QRCOUR.XCONQR(3,13)=UN
  114. QRCOUR.XCONQR(1,14)=ZERO
  115. QRCOUR.XCONQR(2,14)=ZERO
  116. QRCOUR.XCONQR(3,14)=ZERO
  117. *
  118. QRCOUR.XCONQR(1,15)=UNS3
  119. QRCOUR.XCONQR(2,15)=UNS3
  120. QRCOUR.XCONQR(3,15)=UNS3
  121. QRCOUR.XCONQR(1,16)=-UNS3
  122. QRCOUR.XCONQR(2,16)=UNS3
  123. QRCOUR.XCONQR(3,16)=UNS3
  124. QRCOUR.XCONQR(1,17)=-UNS3
  125. QRCOUR.XCONQR(2,17)=-UNS3
  126. QRCOUR.XCONQR(3,17)=UNS3
  127. QRCOUR.XCONQR(1,18)=UNS3
  128. QRCOUR.XCONQR(2,18)=-UNS3
  129. QRCOUR.XCONQR(3,18)=UNS3
  130. *
  131. QRCOUR.XCONQR(1,19)=ZERO
  132. QRCOUR.XCONQR(2,19)=ZERO
  133. QRCOUR.XCONQR(3,19)=UNS5
  134.  
  135. *
  136. * Numero du centre
  137. *
  138. QRCOUR.NUCENT=19
  139. *
  140. * Faces du PY19 : 1 QUA9 + 4 TRI7
  141. *
  142. * Chapeau
  143. NBNN=0
  144. NBELEM=0
  145. NBSOUS=2
  146. NBREF=0
  147. SEGINI MYMEL
  148. * Face QUA9
  149. NBNN=9
  150. NBELEM=1
  151. NBSOUS=0
  152. NBREF=0
  153. SEGINI SOUMEL
  154. CALL FICH4('QUA9',NOMS,NOMBR,
  155. $ NUMER,
  156. $ IMPR,IRET)
  157. IF (IRET.NE.0) GOTO 9999
  158. SOUMEL.ITYPEL=NUMER
  159. * Face 1
  160. SOUMEL.NUM(1,1)=1
  161. SOUMEL.NUM(2,1)=2
  162. SOUMEL.NUM(3,1)=3
  163. SOUMEL.NUM(4,1)=4
  164. SOUMEL.NUM(5,1)=5
  165. SOUMEL.NUM(6,1)=6
  166. SOUMEL.NUM(7,1)=7
  167. SOUMEL.NUM(8,1)=8
  168. SOUMEL.NUM(9,1)=14
  169. *
  170. SEGDES SOUMEL
  171. MYMEL.LISOUS(1)=SOUMEL
  172. * 4 Faces TRI7
  173. NBNN=7
  174. NBELEM=4
  175. NBSOUS=0
  176. NBREF=0
  177. SEGINI SOUMEL
  178. CALL FICH4('TRI7',NOMS,NOMBR,
  179. $ NUMER,
  180. $ IMPR,IRET)
  181. IF (IRET.NE.0) GOTO 9999
  182. SOUMEL.ITYPEL=NUMER
  183. * Face 1
  184. SOUMEL.NUM(1,1)=1
  185. SOUMEL.NUM(2,1)=2
  186. SOUMEL.NUM(3,1)=3
  187. SOUMEL.NUM(4,1)=10
  188. SOUMEL.NUM(5,1)=13
  189. SOUMEL.NUM(6,1)=9
  190. SOUMEL.NUM(7,1)=15
  191. * Face 2
  192. SOUMEL.NUM(1,2)=3
  193. SOUMEL.NUM(2,2)=4
  194. SOUMEL.NUM(3,2)=5
  195. SOUMEL.NUM(4,2)=11
  196. SOUMEL.NUM(5,2)=13
  197. SOUMEL.NUM(6,2)=10
  198. SOUMEL.NUM(7,2)=16
  199. * Face 3
  200. SOUMEL.NUM(1,3)=5
  201. SOUMEL.NUM(2,3)=6
  202. SOUMEL.NUM(3,3)=7
  203. SOUMEL.NUM(4,3)=12
  204. SOUMEL.NUM(5,3)=13
  205. SOUMEL.NUM(6,3)=11
  206. SOUMEL.NUM(7,3)=17
  207. * Face 4
  208. SOUMEL.NUM(1,4)=7
  209. SOUMEL.NUM(2,4)=8
  210. SOUMEL.NUM(3,4)=1
  211. SOUMEL.NUM(4,4)=9
  212. SOUMEL.NUM(5,4)=13
  213. SOUMEL.NUM(6,4)=12
  214. SOUMEL.NUM(7,4)=18
  215. *
  216. SEGDES SOUMEL
  217. MYMEL.LISOUS(2)=SOUMEL
  218. SEGDES MYMEL
  219. QRCOUR.LFACE=MYMEL
  220. SEGDES QRCOUR
  221. MYQRFS.LISQRF(**)=QRCOUR
  222. *
  223. * Normal termination
  224. *
  225. IRET=0
  226. RETURN
  227. *
  228. * Format handling
  229. *
  230. *
  231. * Error handling
  232. *
  233. 9999 CONTINUE
  234. IRET=1
  235. WRITE(IOIMP,*) 'An error was detected in subroutine inqrpy'
  236. RETURN
  237. *
  238. * End of subroutine INQRPY
  239. *
  240. END
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  

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