Télécharger inqrfs.eso

Retour à la liste

Numérotation des lignes :

  1. C INQRFS SOURCE GOUNAND 06/08/04 21:16:17 5520
  2. SUBROUTINE INQRFS(MYQRFS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INQRFS
  7. C PROJET : Noyau linéaire NLIN
  8. C DESCRIPTION : Initialise le segment contenant les informations sur
  9. C les QUAFs de référence.
  10. C
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES :
  16. C APPELES (E/S) : PRQRF
  17. C APPELE PAR :
  18. C***********************************************************************
  19. C ENTREES : -
  20. C SORTIES : MYQRFS
  21. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22. C***********************************************************************
  23. C VERSION : v1, 17/10/02, version initiale
  24. C HISTORIQUE : v1, 17/10/02, création
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29. C en cas de modification de ce sous-programme afin de faciliter
  30. C la maintenance !
  31. C***********************************************************************
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. CBEGININCLUDE SIQUAF
  36. SEGMENT IQUAF
  37. INTEGER NUMQUF
  38. REAL*8 XCONQR(NDIMQR,NBNOQR)
  39. INTEGER NUCENT
  40. POINTEUR LFACE.MELEME
  41. ENDSEGMENT
  42. SEGMENT IQUAFS
  43. POINTEUR LISQRF(NBQRF).IQUAF
  44. ENDSEGMENT
  45. CENDINCLUDE SIQUAF
  46. POINTEUR MYQRFS.IQUAFS
  47. POINTEUR QRCOUR.IQUAF
  48. INTEGER NBQRF
  49. *
  50. INTEGER IMPR,IRET
  51. *
  52. INTEGER NBDQR,INBDQR
  53. *
  54. * Executable statements
  55. *
  56. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrfs'
  57. *
  58. * Initialisation du segment contenant les infos sur les QUAFS
  59. * de référence
  60. *
  61. NBQRF=0
  62. SEGINI MYQRFS
  63. *
  64. * On initialise les QUAFs de référence de dimension 1 (segments)
  65. *
  66. CALL INQRSE(MYQRFS,IMPR,IRET)
  67. IF (IRET.NE.0) GOTO 9999
  68. *
  69. * On initialise les éléments de référence de dimension 2
  70. * de forme géométrique triangulaire.
  71. *
  72. CALL INQRTR(MYQRFS,IMPR,IRET)
  73. IF (IRET.NE.0) GOTO 9999
  74. *
  75. * On initialise les éléments de référence de dimension 2
  76. * de forme géométrique carrée.
  77. *
  78. CALL INQRQU(MYQRFS,IMPR,IRET)
  79. IF (IRET.NE.0) GOTO 9999
  80. *
  81. * On initialise les éléments de référence de dimension 3
  82. * de forme géométrique tétraèdrique.
  83. *
  84. CALL INQRTE(MYQRFS,IMPR,IRET)
  85. IF (IRET.NE.0) GOTO 9999
  86. *
  87. * On initialise les éléments de référence de dimension 3
  88. * de forme géométrique pyramidale.
  89. *
  90. CALL INQRPY(MYQRFS,IMPR,IRET)
  91. IF (IRET.NE.0) GOTO 9999
  92. *
  93. * On initialise les éléments de référence de dimension 3
  94. * de forme géométrique prismatique à base triangle.
  95. *
  96. CALL INQRPR(MYQRFS,IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. *
  99. * On initialise les éléments de référence de dimension 3
  100. * de forme géométrique cubique.
  101. *
  102. CALL INQRCU(MYQRFS,IMPR,IRET)
  103. IF (IRET.NE.0) GOTO 9999
  104. *
  105. * Impression finale
  106. *
  107. NBDQR=MYQRFS.LISQRF(/1)
  108. IF (IMPR.GT.1) THEN
  109. DO 3 INBDQR=1,NBDQR
  110. WRITE(IOIMP,*) 'Quaf. de référence ',INBDQR
  111. QRCOUR=MYQRFS.LISQRF(INBDQR)
  112. CALL PRQRF(QRCOUR,IMPR,IRET)
  113. IF (IRET.NE.0) GOTO 9999
  114. 3 CONTINUE
  115. ENDIF
  116. SEGDES MYQRFS
  117. *
  118. * Normal termination
  119. *
  120. IRET=0
  121. RETURN
  122. *
  123. * Format handling
  124. *
  125. *
  126. * Error handling
  127. *
  128. 9999 CONTINUE
  129. IRET=1
  130. WRITE(IOIMP,*) 'An error was detected in subroutine inqrfs'
  131. RETURN
  132. *
  133. * End of subroutine INQRFS
  134. *
  135. END
  136.  
  137.  
  138.  
  139.  

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