Télécharger inqrse.eso

Retour à la liste

Numérotation des lignes :

inqrse
  1. C INQRSE SOURCE GOUNAND 21/06/02 21:17:00 11022
  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. -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. *
  46. REAL*8 ZERO,UN
  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 inqrse'
  54. *
  55. * Elément QUAF SEG3
  56. *
  57.  
  58. NDIMQR=1
  59. NBNOQR=3
  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('SEG3',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)=-UN
  73. QRCOUR.XCONQR(1,2)=ZERO
  74. QRCOUR.XCONQR(1,3)=UN
  75. *
  76. * Numero du centre
  77. *
  78. QRCOUR.NUCENT=2
  79. *
  80. * Faces du SEG3 : 2 POI1
  81. *
  82. * Chapeau
  83. NBNN=0
  84. NBELEM=0
  85. NBSOUS=1
  86. NBREF=0
  87. SEGINI MYMEL
  88. * Faces SEG3
  89. NBNN=3
  90. NBELEM=3
  91. NBSOUS=0
  92. NBREF=0
  93. SEGINI SOUMEL
  94. CALL FICH4('POI1',NOMS,NOMBR,
  95. $ NUMER,
  96. $ IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. SOUMEL.ITYPEL=NUMER
  99. * Face 1
  100. SOUMEL.NUM(1,1)=1
  101. * Face 2
  102. SOUMEL.NUM(1,2)=3
  103. SEGDES SOUMEL
  104. MYMEL.LISOUS(1)=SOUMEL
  105. SEGDES MYMEL
  106. QRCOUR.LFACE=MYMEL
  107.  
  108. *
  109. * Pas de faces pour un segment
  110. *
  111. SEGDES QRCOUR
  112. MYQRFS.LISQRF(**)=QRCOUR
  113. *
  114. * Normal termination
  115. *
  116. IRET=0
  117. RETURN
  118. *
  119. * Format handling
  120. *
  121. *
  122. * Error handling
  123. *
  124. 9999 CONTINUE
  125. IRET=1
  126. WRITE(IOIMP,*) 'An error was detected in subroutine inqrse'
  127. RETURN
  128. *
  129. * End of subroutine INQRSE
  130. *
  131. END
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  

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