Télécharger inqrqu.eso

Retour à la liste

Numérotation des lignes :

  1. C INQRQU SOURCE BP208322 16/11/18 21:17:46 9177
  2. SUBROUTINE INQRQU(MYQRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INQRQU
  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, 21/07/03, version initiale
  22. C HISTORIQUE : v1, 21/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. *
  53. INTEGER IMPR,IRET
  54. REAL*8 ZERO,UN
  55. *
  56. PARAMETER (ZERO=0.D0,UN=1.D0)
  57. *
  58. INTEGER NUMER
  59. *
  60. * Executable statements
  61. *
  62. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrqu'
  63. *
  64. * Elément QUAF QUA9
  65. *
  66. NDIMQR=2
  67. NBNOQR=9
  68. SEGINI QRCOUR
  69. * Numéro de l'élément géométrique dans NOMS
  70. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  71. * cf. include CCGEOME
  72. CALL FICH4('QUA9',NOMS,NOMBR,
  73. $ NUMER,
  74. $ IMPR,IRET)
  75. IF (IRET.NE.0) GOTO 9999
  76. QRCOUR.NUMQUF=NUMER
  77. *
  78. * Coordonnées des noeuds du QUAF de référence
  79. *
  80. QRCOUR.XCONQR(1,1)=-UN
  81. QRCOUR.XCONQR(2,1)=-UN
  82. QRCOUR.XCONQR(1,2)=ZERO
  83. QRCOUR.XCONQR(2,2)=-UN
  84. QRCOUR.XCONQR(1,3)=UN
  85. QRCOUR.XCONQR(2,3)=-UN
  86. QRCOUR.XCONQR(1,4)=UN
  87. QRCOUR.XCONQR(2,4)=ZERO
  88. QRCOUR.XCONQR(1,5)=UN
  89. QRCOUR.XCONQR(2,5)=UN
  90. QRCOUR.XCONQR(1,6)=ZERO
  91. QRCOUR.XCONQR(2,6)=UN
  92. QRCOUR.XCONQR(1,7)=-UN
  93. QRCOUR.XCONQR(2,7)=UN
  94. QRCOUR.XCONQR(1,8)=-UN
  95. QRCOUR.XCONQR(2,8)=ZERO
  96. QRCOUR.XCONQR(1,9)=ZERO
  97. QRCOUR.XCONQR(2,9)=ZERO
  98. *
  99. * Numero du centre
  100. *
  101. QRCOUR.NUCENT=9
  102. *
  103. * Faces du QUA9 : 4 SEG3
  104. *
  105. * Chapeau
  106. NBNN=0
  107. NBELEM=0
  108. NBSOUS=1
  109. NBREF=0
  110. SEGINI MYMEL
  111. * Faces SEG3
  112. NBNN=3
  113. NBELEM=4
  114. NBSOUS=0
  115. NBREF=0
  116. SEGINI SOUMEL
  117. CALL FICH4('SEG3',NOMS,NOMBR,
  118. $ NUMER,
  119. $ IMPR,IRET)
  120. IF (IRET.NE.0) GOTO 9999
  121. SOUMEL.ITYPEL=NUMER
  122. * Face 1
  123. SOUMEL.NUM(1,1)=1
  124. SOUMEL.NUM(2,1)=2
  125. SOUMEL.NUM(3,1)=3
  126. * Face 2
  127. SOUMEL.NUM(1,2)=3
  128. SOUMEL.NUM(2,2)=4
  129. SOUMEL.NUM(3,2)=5
  130. * Face 3
  131. SOUMEL.NUM(1,3)=5
  132. SOUMEL.NUM(2,3)=6
  133. SOUMEL.NUM(3,3)=7
  134. * Face 4
  135. SOUMEL.NUM(1,4)=7
  136. SOUMEL.NUM(2,4)=8
  137. SOUMEL.NUM(3,4)=1
  138. SEGDES SOUMEL
  139. MYMEL.LISOUS(1)=SOUMEL
  140. SEGDES MYMEL
  141. QRCOUR.LFACE=MYMEL
  142. SEGDES QRCOUR
  143. MYQRFS.LISQRF(**)=QRCOUR
  144. *
  145. * Normal termination
  146. *
  147. IRET=0
  148. RETURN
  149. *
  150. * Format handling
  151. *
  152. *
  153. * Error handling
  154. *
  155. 9999 CONTINUE
  156. IRET=1
  157. WRITE(IOIMP,*) 'An error was detected in subroutine inqrqu'
  158. RETURN
  159. *
  160. * End of subroutine INQRQU
  161. *
  162. END
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  

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