Télécharger inqrtr.eso

Retour à la liste

Numérotation des lignes :

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

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