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

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