Télécharger inqrqu.eso

Retour à la liste

Numérotation des lignes :

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

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