Télécharger prcael.eso

Retour à la liste

Numérotation des lignes :

  1. C PRCAEL SOURCE GOUNAND 05/12/21 21:34:54 5281
  2. SUBROUTINE PRCAEL(MYCAEL,
  3. $ IMPR,IRET)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : PRCAEL
  8. C PROJET : Noyau linéaire NLIN
  9. C DESCRIPTION : Imprime un champ par élément (type MCHAEL)
  10. C LANGAGE : ESOPE
  11. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  12. C mél : gounand@semt2.smts.cea.fr
  13. C***********************************************************************
  14. C APPELES : OOOETA (état d'un segment)
  15. C PRCHVA (impression d'un segment MCHEVA)
  16. C APPELES (E/S) : ECROBJ, PRLIST (écriture, impression)
  17. C APPELE PAR : MKCOOR
  18. C***********************************************************************
  19. C ENTREES : * MYCAEL (type MCHAEL) : le champ par éléments à
  20. C imprimer.
  21. C SORTIES : -
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 03/09/99, version initiale
  25. C HISTORIQUE : v1, 03/09/99, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33. -INC CCOPTIO
  34. CBEGININCLUDE SMCHAEL
  35. SEGMENT MCHAEL
  36. POINTEUR IMACHE(N1).MELEME
  37. POINTEUR ICHEVA(N1).MCHEVA
  38. ENDSEGMENT
  39. SEGMENT MCHEVA
  40. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  41. ENDSEGMENT
  42. SEGMENT LCHEVA
  43. POINTEUR LISCHE(NBCHE).MCHEVA
  44. ENDSEGMENT
  45. CENDINCLUDE SMCHAEL
  46. POINTEUR MYCAEL.MCHAEL
  47. POINTEUR MYCHVA.MCHEVA
  48. -INC SMELEME
  49. POINTEUR MYMACH.MELEME
  50. *
  51. INTEGER IMPR,IRET
  52. *
  53. INTEGER ISOUS
  54. INTEGER NSOUS
  55. INTEGER MCAETA,MACETA
  56. *
  57. * Executable statements
  58. *
  59. * On veut laisser MYCAEL dans le même état (actif, inactif) qu'avant
  60. * l'appel à PRCAEL.
  61. CALL OOOETA(MYCAEL,MCAETA)
  62. IF (MCAETA.NE.1) SEGACT MYCAEL
  63. WRITE(IOIMP,*) 'Segment MCHAEL de pointeur',MYCAEL
  64. IF (IMPR.GT.1) THEN
  65. NSOUS=MYCAEL.ICHEVA(/1)
  66. WRITE(IOIMP,*) 'Nombre de partitions :',NSOUS
  67. IF (IMPR.GT.2) THEN
  68. DO 1 ISOUS=1,NSOUS
  69. MYMACH=MYCAEL.IMACHE(ISOUS)
  70. MYCHVA=MYCAEL.ICHEVA(ISOUS)
  71. WRITE(IOIMP,*) 'Sous-champ ',ISOUS,' : supp. géo. ',
  72. $ MYMACH,' MCHEVA=',MYCHVA
  73. IF (IMPR.GT.3) THEN
  74. IF (IMPR.GT.5) THEN
  75. IF (MYMACH.NE.0) THEN
  76. CALL OOOETA(MYMACH,MACETA)
  77. WRITE(IOIMP,*) 'Support géométrique'
  78. CALL ECROBJ('MAILLAGE',MYMACH)
  79. CALL PRLIST
  80. IF (MACETA.NE.1) THEN
  81. SEGDES MYMACH
  82. ELSE
  83. SEGACT MYMACH
  84. ENDIF
  85. ENDIF
  86. ENDIF
  87. WRITE(IOIMP,*) 'Valeurs du champ par éléments'
  88. CALL PRCHVA(MYCHVA,IMPR,IRET)
  89. IF (IRET.NE.0) GOTO 9999
  90. ENDIF
  91. 1 CONTINUE
  92. ENDIF
  93. ENDIF
  94. IF (MCAETA.NE.1) SEGDES MYCAEL
  95. *
  96. * Normal termination
  97. *
  98. IRET=0
  99. RETURN
  100. *
  101. * Format handling
  102. *
  103. *
  104. * Error handling
  105. *
  106. 9999 CONTINUE
  107. IRET=1
  108. WRITE(IOIMP,*) 'An error was detected in subroutine prcael'
  109. RETURN
  110. *
  111. * End of subroutine prcael
  112. *
  113. END
  114.  
  115.  
  116.  

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