Télécharger inqrse.eso

Retour à la liste

Numérotation des lignes :

  1. C INQRSE SOURCE BP208322 16/11/18 21:17:47 9177
  2. SUBROUTINE INQRSE(MYQRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INQRSE
  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. 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. *
  55. REAL*8 ZERO,UN
  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 inqrse'
  63. *
  64. * Elément QUAF SEG3
  65. *
  66.  
  67. NDIMQR=1
  68. NBNOQR=3
  69. SEGINI QRCOUR
  70. * Numéro de l'élément géométrique dans NOMS
  71. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  72. * cf. include CCGEOME
  73. CALL FICH4('SEG3',NOMS,NOMBR,
  74. $ NUMER,
  75. $ IMPR,IRET)
  76. IF (IRET.NE.0) GOTO 9999
  77. QRCOUR.NUMQUF=NUMER
  78. *
  79. * Coordonnées des noeuds du QUAF de référence
  80. *
  81. QRCOUR.XCONQR(1,1)=-UN
  82. QRCOUR.XCONQR(1,2)=ZERO
  83. QRCOUR.XCONQR(1,3)=UN
  84. *
  85. * Numero du centre
  86. *
  87. QRCOUR.NUCENT=2
  88. *
  89. * Faces du SEG3 : 2 POI1
  90. *
  91. * Chapeau
  92. NBNN=0
  93. NBELEM=0
  94. NBSOUS=1
  95. NBREF=0
  96. SEGINI MYMEL
  97. * Faces SEG3
  98. NBNN=3
  99. NBELEM=3
  100. NBSOUS=0
  101. NBREF=0
  102. SEGINI SOUMEL
  103. CALL FICH4('POI1',NOMS,NOMBR,
  104. $ NUMER,
  105. $ IMPR,IRET)
  106. IF (IRET.NE.0) GOTO 9999
  107. SOUMEL.ITYPEL=NUMER
  108. * Face 1
  109. SOUMEL.NUM(1,1)=1
  110. * Face 2
  111. SOUMEL.NUM(1,2)=3
  112. SEGDES SOUMEL
  113. MYMEL.LISOUS(1)=SOUMEL
  114. SEGDES MYMEL
  115. QRCOUR.LFACE=MYMEL
  116.  
  117. *
  118. * Pas de faces pour un segment
  119. *
  120. SEGDES QRCOUR
  121. MYQRFS.LISQRF(**)=QRCOUR
  122. *
  123. * Normal termination
  124. *
  125. IRET=0
  126. RETURN
  127. *
  128. * Format handling
  129. *
  130. *
  131. * Error handling
  132. *
  133. 9999 CONTINUE
  134. IRET=1
  135. WRITE(IOIMP,*) 'An error was detected in subroutine inqrse'
  136. RETURN
  137. *
  138. * End of subroutine INQRSE
  139. *
  140. END
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  

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