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

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