Télécharger inqrpr.eso

Retour à la liste

Numérotation des lignes :

  1. C INQRPR SOURCE BP208322 16/11/18 21:17:45 9177
  2. SUBROUTINE INQRPR(MYQRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INQRPR
  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, 15/03/04, version initiale
  22. C HISTORIQUE : v1, 15/03/04, 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. -INC SMLENTI
  51. POINTEUR INOD.MLENTI
  52. -INC SMLREEL
  53. POINTEUR ZVAL.MLREEL
  54. POINTEUR YVAL.MLREEL
  55. POINTEUR XVAL.MLREEL
  56. *
  57. INTEGER IMPR,IRET
  58. REAL*8 ZERO,UN
  59. REAL*8 UNS3
  60. REAL*8 UNS2
  61. PARAMETER (UNS3=1.D0/3.D0)
  62. PARAMETER (UNS2=1.D0/2.D0)
  63. PARAMETER (ZERO=0.D0,UN=1.D0)
  64. *
  65. INTEGER NUMER
  66. *
  67. * Executable statements
  68. *
  69. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrpr'
  70. *
  71. * Elément QUAF PR21
  72. *
  73. NDIMQR=3
  74. NBNOQR=21
  75. SEGINI QRCOUR
  76. * Numéro de l'élément géométrique dans NOMS
  77. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  78. * cf. include CCGEOME
  79. CALL FICH4('PR21',NOMS,NOMBR,
  80. $ NUMER,
  81. $ IMPR,IRET)
  82. IF (IRET.NE.0) GOTO 9999
  83. QRCOUR.NUMQUF=NUMER
  84. *
  85. * Coordonnées des noeuds du QUAF de référence
  86. *
  87. JG=21
  88. SEGINI INOD
  89. DO IDDL=1,6
  90. INOD.LECT(IDDL)=IDDL
  91. ENDDO
  92. INOD.LECT( 7)=19
  93. INOD.LECT( 8)= 7
  94. INOD.LECT( 9)=16
  95. INOD.LECT(10)= 8
  96. INOD.LECT(11)=17
  97. INOD.LECT(12)= 9
  98. INOD.LECT(13)=18
  99. INOD.LECT(14)=21
  100. DO IDDL=15,20
  101. INOD.LECT(IDDL)=IDDL-5
  102. ENDDO
  103. INOD.LECT(21)=20
  104. *
  105. JG=3
  106. SEGINI ZVAL
  107. ZVAL.PROG(1)=-UN
  108. ZVAL.PROG(2)=ZERO
  109. ZVAL.PROG(3)=UN
  110. JG=7
  111. SEGINI XVAL
  112. SEGINI YVAL
  113. XVAL.PROG(1)=ZERO
  114. YVAL.PROG(1)=ZERO
  115. XVAL.PROG(2)=UNS2
  116. YVAL.PROG(2)=ZERO
  117. XVAL.PROG(3)=UN
  118. YVAL.PROG(3)=ZERO
  119. XVAL.PROG(4)=UNS2
  120. YVAL.PROG(4)=UNS2
  121. XVAL.PROG(5)=ZERO
  122. YVAL.PROG(5)=UN
  123. XVAL.PROG(6)=ZERO
  124. YVAL.PROG(6)=UNS2
  125. XVAL.PROG(7)=UNS3
  126. YVAL.PROG(7)=UNS3
  127. ICPT=0
  128. DO IZ=1,3
  129. DO IT=1,7
  130. ICPT=ICPT+1
  131. JNOD=INOD.LECT(ICPT)
  132. QRCOUR.XCONQR(1,JNOD)=XVAL.PROG(IT)
  133. QRCOUR.XCONQR(2,JNOD)=YVAL.PROG(IT)
  134. QRCOUR.XCONQR(3,JNOD)=ZVAL.PROG(IZ)
  135. ENDDO
  136. ENDDO
  137. SEGSUP ZVAL
  138. SEGSUP YVAL
  139. SEGSUP XVAL
  140. SEGSUP INOD
  141. *
  142. * Numero du centre
  143. *
  144. QRCOUR.NUCENT=21
  145. *
  146. * Faces du PR21 : 2 TRI7 + 3 QUA9
  147. *
  148. * Chapeau
  149. NBNN=0
  150. NBELEM=0
  151. NBSOUS=2
  152. NBREF=0
  153. SEGINI MYMEL
  154. * 2 Faces TRI7
  155. NBNN=7
  156. NBELEM=2
  157. NBSOUS=0
  158. NBREF=0
  159. SEGINI SOUMEL
  160. CALL FICH4('TRI7',NOMS,NOMBR,
  161. $ NUMER,
  162. $ IMPR,IRET)
  163. IF (IRET.NE.0) GOTO 9999
  164. SOUMEL.ITYPEL=NUMER
  165. * Face 1
  166. SOUMEL.NUM(1,1)=1
  167. SOUMEL.NUM(2,1)=2
  168. SOUMEL.NUM(3,1)=3
  169. SOUMEL.NUM(4,1)=4
  170. SOUMEL.NUM(5,1)=5
  171. SOUMEL.NUM(6,1)=6
  172. SOUMEL.NUM(7,1)=19
  173. * Face 2
  174. SOUMEL.NUM(1,2)=10
  175. SOUMEL.NUM(2,2)=<{p!n style="color: #cc66cc;">11
  176. SOUMEL.NUM(3,2)=12
  177. SOUMEL.NUM(4,2)=13
  178. SOUMEL.NUM(5,2)=14
  179. SOUMEL.NUM(6,2)=15
  180. SOUMEL.NUM(7,2)=20
  181. SEGDES SOUMEL
  182. MYMEL.LISOUS(1)=SOUMEL
  183. * 3 Faces QUA9
  184. NBNN=9
  185. NBELEM=3
  186. NBSOUS=0
  187. NBREF=0
  188. SEGINI SOUMEL
  189. CALL FICH4('QUA9',NOMS,NOMBR,
  190. $ NUMER,
  191. $ IMPR,IRET)
  192. IF (IRET.NE.0) GOTO 9999
  193. SOUMEL.ITYPEL=NUMER
  194. * Face 1
  195. SOUMEL.NUM(1,1)=1
  196. SOUMEL.NUM(2,1)=2
  197. SOUMEL.NUM(3,1)=3
  198. SOUMEL.NUM(4,1)=8
  199. SOUMEL.NUM(5,1)=12
  200. SOUMEL.NUM(6,1)=11
  201. SOUMEL.NUM(7,1)=10
  202. SOUMEL.NUM(8,1)=7
  203. SOUMEL.NUM(9,1)=16
  204. * Face 2
  205. SOUMEL.NUM(1,2)=3
  206. SOUMEL.NUM(2,2)=4
  207. SOUMEL.NUM(3,2)=5
  208. SOUMEL.NUM(4,2)=9
  209. SOUMEL.NUM(5,2)=14
  210. SOUMEL.NUM(6,2)=13
  211. SOUMEL.NUM(7,2)=12
  212. SOUMEL.NUM(8,2)=8
  213. SOUMEL.NUM(9,2)=17
  214. * Face 3
  215. SOUMEL.NUM(1,3)=5
  216. SOUMEL.NUM(2,3)=6
  217. SOUMEL.NUM(3,3)=1
  218. SOUMEL.NUM(4,3)=7
  219. SOUMEL.NUM(5,3)=10
  220. SOUMEL.NUM(6,3)=15
  221. SOUMEL.NUM(7,3)=14
  222. SOUMEL.NUM(8,3)=9
  223. SOUMEL.NUM(9,3)=18
  224. SEGDES SOUMEL
  225. MYMEL.LISOUS(2)=SOUMEL
  226. SEGDES MYMEL
  227. QRCOUR.LFACE=MYMEL
  228. SEGDES QRCOUR
  229. MYQRFS.LISQRF(**)=QRCOUR
  230. *
  231. * Normal termination
  232. *
  233. IRET=0
  234. RETURN
  235. *
  236. * Format handling
  237. *
  238. *
  239. * Error handling
  240. *
  241. 9999 CONTINUE
  242. IRET=1
  243. WRITE(IOIMP,*) 'An error was detected in subroutine inqrpr'
  244. RETURN
  245. *
  246. * End of subroutine INQRPR
  247. *
  248. END
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  

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