Télécharger inqrcu.eso

Retour à la liste

Numérotation des lignes :

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

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