Télécharger inqrtr.eso

Retour à la liste

Numérotation des lignes :

  1. C INQRTR SOURCE BP208322 16/11/18 21:17:48 9177
  2. SUBROUTINE INQRTR(MYQRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INQRTR
  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, 17/10/02, version initiale
  22. C HISTORIQUE : v1, 17/10/02, 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. *
  51. INTEGER IMPR,IRET
  52. REAL*8 ZERO,UN,UNS3,UNS2
  53. *
  54. PARAMETER (ZERO=0.D0,UN=1.D0,UNS3=1.D0/3.D0,UNS2=1.D0/2.D0)
  55. *
  56. INTEGER NUMER
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrtr'
  61. *
  62. * Elément QUAF TRI7
  63. *
  64.  
  65. NDIMQR=2
  66. NBNOQR=7
  67. SEGINI QRCOUR
  68. * Numéro de l'élément géométrique dans NOMS
  69. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  70. * cf. include CCGEOME
  71. CALL FICH4('TRI7',NOMS,NOMBR,
  72. $ NUMER,
  73. $ IMPR,IRET)
  74. IF (IRET.NE.0) GOTO 9999
  75. QRCOUR.NUMQUF=NUMER
  76. *
  77. * Coordonnées des noeuds du QUAF de référence
  78. *
  79. QRCOUR.XCONQR(1,1)=ZERO
  80. QRCOUR.XCONQR(2,1)=ZERO
  81. QRCOUR.XCONQR(1,2)=UNS2
  82. QRCOUR.XCONQR(2,2)=ZERO
  83. QRCOUR.XCONQR(1,3)=UN
  84. QRCOUR.XCONQR(2,3)=ZERO
  85. QRCOUR.XCONQR(1,4)=UNS2
  86. QRCOUR.XCONQR(2,4)=UNS2
  87. QRCOUR.XCONQR(1,5)=ZERO
  88. QRCOUR.XCONQR(2,5)=UN
  89. QRCOUR.XCONQR(1,6)=ZERO
  90. QRCOUR.XCONQR(2,6)=UNS2
  91. QRCOUR.XCONQR(1,7)=UNS3
  92. QRCOUR.XCONQR(2,7)=UNS3
  93. *
  94. * Numero du centre
  95. *
  96. QRCOUR.NUCENT=7
  97. *
  98. * Faces du TRI7 : 3 SEG3
  99. *
  100. * Chapeau
  101. NBNN=0
  102. NBELEM=0
  103. NBSOUS=1
  104. NBREF=0
  105. SEGINI MYMEL
  106. * Faces SEG3
  107. NBNN=3
  108. NBELEM=3
  109. NBSOUS=0
  110. NBREF=0
  111. SEGINI SOUMEL
  112. CALL FICH4('SEG3',NOMS,NOMBR,
  113. $ NUMER,
  114. $ IMPR,IRET)
  115. IF (IRET.NE.0) GOTO 9999
  116. SOUMEL.ITYPEL=NUMER
  117. * Face 1
  118. SOUMEL.NUM(1,1)=1
  119. SOUMEL.NUM(2,1)=2
  120. SOUMEL.NUM(3,1)=3
  121. * Face 2
  122. SOUMEL.NUM(1,2)=3
  123. SOUMEL.NUM(2,2)=4
  124. SOUMEL.NUM(3,2)=5
  125. * Face 3
  126. SOUMEL.NUM(1,3)=5
  127. SOUMEL.NUM(2,3)=6
  128. SOUMEL.NUM(3,3)=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 inqrtr'
  149. RETURN
  150. *
  151. * End of subroutine INQRTR
  152. *
  153. END
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  

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