Télécharger inqrfs.eso

Retour à la liste

Numérotation des lignes :

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

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