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. -INC CCOPTIO
  33. CBEGININCLUDE SIQUAF
  34. SEGMENT IQUAF
  35. INTEGER NUMQUF
  36. REAL*8 XCONQR(NDIMQR,NBNOQR)
  37. INTEGER NUCENT
  38. POINTEUR LFACE.MELEME
  39. ENDSEGMENT
  40. SEGMENT IQUAFS
  41. POINTEUR LISQRF(NBQRF).IQUAF
  42. ENDSEGMENT
  43. CENDINCLUDE SIQUAF
  44. POINTEUR MYQRFS.IQUAFS
  45. POINTEUR QRCOUR.IQUAF
  46. INTEGER NBQRF
  47. *
  48. INTEGER IMPR,IRET
  49. *
  50. INTEGER NBDQR,INBDQR
  51. *
  52. * Executable statements
  53. *
  54. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrfs'
  55. *
  56. * Initialisation du segment contenant les infos sur les QUAFS
  57. * de référence
  58. *
  59. NBQRF=0
  60. SEGINI MYQRFS
  61. *
  62. * On initialise les QUAFs de référence de dimension 1 (segments)
  63. *
  64. CALL INQRSE(MYQRFS,IMPR,IRET)
  65. IF (IRET.NE.0) GOTO 9999
  66. *
  67. * On initialise les éléments de référence de dimension 2
  68. * de forme géométrique triangulaire.
  69. *
  70. CALL INQRTR(MYQRFS,IMPR,IRET)
  71. IF (IRET.NE.0) GOTO 9999
  72. *
  73. * On initialise les éléments de référence de dimension 2
  74. * de forme géométrique carrée.
  75. *
  76. CALL INQRQU(MYQRFS,IMPR,IRET)
  77. IF (IRET.NE.0) GOTO 9999
  78. *
  79. * On initialise les éléments de référence de dimension 3
  80. * de forme géométrique tétraèdrique.
  81. *
  82. CALL INQRTE(MYQRFS,IMPR,IRET)
  83. IF (IRET.NE.0) GOTO 9999
  84. *
  85. * On initialise les éléments de référence de dimension 3
  86. * de forme géométrique pyramidale.
  87. *
  88. CALL INQRPY(MYQRFS,IMPR,IRET)
  89. IF (IRET.NE.0) GOTO 9999
  90. *
  91. * On initialise les éléments de référence de dimension 3
  92. * de forme géométrique prismatique à base triangle.
  93. *
  94. CALL INQRPR(MYQRFS,IMPR,IRET)
  95. IF (IRET.NE.0) GOTO 9999
  96. *
  97. * On initialise les éléments de référence de dimension 3
  98. * de forme géométrique cubique.
  99. *
  100. CALL INQRCU(MYQRFS,IMPR,IRET)
  101. IF (IRET.NE.0) GOTO 9999
  102. *
  103. * Impression finale
  104. *
  105. NBDQR=MYQRFS.LISQRF(/1)
  106. IF (IMPR.GT.1) THEN
  107. DO 3 INBDQR=1,NBDQR
  108. WRITE(IOIMP,*) 'Quaf. de référence ',INBDQR
  109. QRCOUR=MYQRFS.LISQRF(INBDQR)
  110. CALL PRQRF(QRCOUR,IMPR,IRET)
  111. IF (IRET.NE.0) GOTO 9999
  112. 3 CONTINUE
  113. ENDIF
  114. SEGDES MYQRFS
  115. *
  116. * Normal termination
  117. *
  118. IRET=0
  119. RETURN
  120. *
  121. * Format handling
  122. *
  123. *
  124. * Error handling
  125. *
  126. 9999 CONTINUE
  127. IRET=1
  128. WRITE(IOIMP,*) 'An error was detected in subroutine inqrfs'
  129. RETURN
  130. *
  131. * End of subroutine INQRFS
  132. *
  133. END
  134.  
  135.  
  136.  
  137.  

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